Объединить данные в несколько строк в одну строку

Question

У меня есть таблица с информацией о людях (имя, номер HP, номер дома, адрес электронной почты и т.д.). Однако они находятся в разных строках, и не во всех строках есть вся информация.

Как объединить всю информацию об одном человеке в один ряд?

Текущий

Желаемый

Answer 1

Я бы сделал это с помощью 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

Вот так выглядел мой Excel

И после того, как я запускаю вышеупомянутый макрос

Как видите, я решил добавить результаты к стороне исходной таблицы, так как это не разрушительно

Answer 2

Этот макрос заполнит все пустые ячейки правильной информацией, если он заполнен в любой из строк. Затем вы можете использовать расширенный фильтр для копирования уникальных строк.

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