Kết hợp dữ liệu trong nhiều hàng thành một hàng

Tôi có một bảng với thông tin về mọi người (Tên, Số HP, Số nhà, Email, v.v.). Tuy nhiên, chúng ở các hàng khác nhau và không phải tất cả các hàng đều có thông tin.

Làm cách nào để kết hợp tất cả thông tin về một người thành một hàng?

Hiện hành

Mong muốn

Tôi sẽ làm điều này bằng cách sử dụng 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

Đây là những gì Excel của tôi trông giống như

Và sau khi tôi chạy macro ở trên

Như bạn có thể thấy, tôi đã chọn thêm kết quả vào bên cạnh bảng ban đầu, vì nó không phá hủy

Macro này sẽ điền vào bất kỳ ô trống nào với thông tin chính xác nếu nó được điền vào bất kỳ hàng nào. Sau đó, bạn có thể sử dụng bộ lọc nâng cao để sao chép các hàng duy nhất.

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