Como combinar valores de várias linhas em uma única linha usando o módulo?

0

Estou procurando combinar várias linhas em uma única linha com base em um valor na coluna de código. Observei outras perguntas aqui semelhantes à minha pergunta, mas não consigo estender o intervalo.

Code    Name    Value A Value B Value C Value D Value E
101   Example      #                
101   Example                       
101   Example                     #     
101   Example                            #  
101   Example                                    #
102   Example2                                   #
102   Example2                           #  
102   Example2                    #     
102   Example2            #         
102   Example2     #

O resultado final é assim:

Code    Name    Value A Value B Value C Value D Value E
101    Example     #               #       #       #
102    Example2    #       #       #       #       #

Editar

Isso é o que eu tenho até agora, meu plano era mudar os itens para a linha acima antes de excluir a linha inteira, já que uma linha pode ter muitos itens.

Dim RowNum, LastRow, Col As Long

RowNum = 2
Col = 3

LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 7)).Select

For Each row In Selection
    With Cells
        If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
            For Each Cell In row
                If Cell > 0 Then
                Cells(RowNum + 1, Col).Copy Destination:=Cells(RowNum, Col)
                Else
                Col = Col + 1
            End If
        Rows(RowNum + 1).EntireRow.Delete
        End If
  End With

RowNum = RowNum + 1

Next row
    
por damm 30.01.2014 / 13:08

1 resposta

1

Estou com vergonha da resposta em que você baseou seu código. Faça o backup dos seus dados e teste em uma cópia!

Isso deve funcionar:

Sub combine()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c <> "" Then
       For i = 1 To 6
            If c.Offset(1, i) <> "" Then
                c.Offset(, i) = c.Offset(1, i)
            End If
       Next
       c.Offset(1).EntireRow.Delete
End If

Next

End Sub
    
por 31.01.2014 / 18:04