Combine dados em várias linhas em uma única linha

Question

Eu tenho uma tabela com informações sobre as pessoas (Nome, HP No., Home No., Email etc). No entanto, eles estão em linhas diferentes e nem todas as linhas têm todas as informações.

Como faço para combinar todas as informações sobre uma pessoa em uma única linha?

Atual

Desejado

    

Answer 1

Eu faria isso usando o VBa

Sub Pirates()

Range("F:I").Cells.Clear

'first, copy the headers

Range("F1").Value = Range("A1").Value
Range("G1").Value = Range("B1").Value
Range("H1").Value = Range("C1").Value
Range("I1").Value = Range("D1").Value

'now, to work out the content

Dim row As Integer
row = 2

Dim resultRow As Integer
resultRow = 2

Dim previousName As String
    previousName = Range("A" & row).Value


Do While (Range("A" & row).Value <> "")

    Dim currentName As String
    currentName = Range("A" & row).Value

    If (currentName <> previousName) Then
        resultRow = resultRow + 1
        previousName = currentName
    End If

        If Range("A" & row).Value <> "" Then
            Range("F" & resultRow).Value = Range("A" & row).Value
        End If

        If Range("B" & row).Value <> "" Then
            Range("G" & resultRow).Value = Range("B" & row).Value
        End If

        If Range("C" & row).Value <> "" Then
            Range("H" & resultRow).Value = Range("C" & row).Value
        End If

        If Range("D" & row).Value <> "" Then
            Range("I" & resultRow).Value = Range("D" & row).Value
        End If

        row = row + 1



Loop

End Sub

Isto é o que meu Excel parecia

Depoisdeexecutaramacroacima

Como você pode ver, optei por adicionar os resultados ao lado da tabela inicial, já que não é destrutivo

    

Answer 2

Esta macro preencherá todas as células em branco com as informações corretas se for preenchida em qualquer uma das linhas. Você pode então usar o filtro avançado para copiar linhas exclusivas.

Sub CopyData()

Application.ScreenUpdating = False
Dim i As Long
Dim j As Long
Dim k As Long
Dim rownum As Long
Dim colnum As Long

rownum = Application.WorksheetFunction.CountA(Range("A:A"))
colnum = Application.WorksheetFunction.CountA(Range("A1:AAA1"))


For i = 2 To rownum
    For j = 1 To colnum
        If IsEmpty(Cells(i, j)) = False Then
            For k = 1 To rownum
                If Trim(Cells(k, 1)) = Trim(Cells(i, 1)) Then
                    Cells(k, j) = Cells(i, j)
                End If
            Next k


        End If
    Next j
Next i


End Sub