Excel Macro将数据合并为单行

Question

过去十年来，我将多个数据库组合在一起，形成了数千行和大约50列。请参阅附件以获取有关我要实现的目标的参考。谢谢！

输入

输出

Answer 1

Option Explicit

    Sub compileData()

        Dim a As Long, c As Long, r As Long, lc As Long
        Dim brng As Range, arr As Variant

        With Worksheets("sheet4")

            Set brng = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A") _
                          .End(xlUp)).SpecialCells(xlCellTypeBlanks)
            lc = .Cells.Find(What:="*", SearchDirection:=xlPrevious, _
                             After:=.Cells(1), SearchOrder:=xlByColumns).Column

            For a = 1 To brng.Areas.Count

                arr = brng.Areas(a).Offset(1, 0).Resize(3, lc).Value

                For c = 2 To lc
                    If IsEmpty(arr(1, c)) Then
                        If Not IsEmpty(arr(2, c)) Then
                            arr(1, c) = arr(2, c)
                        ElseIf Not IsEmpty(arr(3, c)) Then
                            arr(1, c) = arr(3, c)
                        Else
                            arr(1, c) = "UNK"
                        End If
                    End If
                Next c

                brng.Areas(a).Offset(1, 0).Resize(1, lc) = arr
            Next a

            brng.EntireRow.Delete

            .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp)).Resize(, lc) _
              .RemoveDuplicates Columns:=1, Header:=xlYes

        End With

    End Sub