Excel 对齐列表

Question

我有一些文件，其内容大致如下所示，其中有一堆列被截断了。

这些文件的大概样子如下：

我需要将这些文件合并到一个电子表格中根据接入值这样它们看起来就像这样：

注意不匹配的结果在最后。最有可能的情况是，例如文件 1 和文件 2 中有匹配的行，但在文件 3 中却没有；或者文件 2 和文件 3 中有匹配的行，但没有一行。

我希望我解释了需要的内容，如果需要更多示例/说明，请告诉我。

Answer 1

将其放入工作簿中合并结果所在的常规 vba 模块中。
编辑常量并运行。

Option Explicit

' Add a dialogue (Application.FileDialog) for file selection
'   and InputBox for sheet selection
'   Or a Form to select the files & their respective sheets.
'
Private Const wbName1 = "file1.xlsx"
Private Const wsName1 = "Sheet1"
Private Const wbName2 = "file2.xlsx"
Private Const wsName2 = "Sheet1"
Private Const wbName3 = "file3.xlsx"
Private Const wsName3 = "Sheet1"
Private Const cStart = "A2" ' data colum and row start
Private Const outputSheet = "Sheet1"

Public Sub MergeFiles()

    Dim wbName(0 To 2) As String, wsName(0 To 2) As String
    Dim r(0 To 2) As Range
    Dim c(1 To 7) As Collection

    Dim z As Long
    Dim w As Long
    Dim i As Long, j As Long
    Dim startColumn As String
    Dim errorNo As Long
    Dim a As Variant, b As Variant, v As Variant

    For i = 7 To 1 Step -1
        Set c(i) = New Collection
    Next i

    wbName(0) = wbName1: wbName(1) = wbName2: wbName(2) = wbName3
    wsName(0) = wsName1: wsName(1) = wsName2: wsName(2) = wsName3
    startColumn = Split(Range(cStart).Address(True, False), "$")(0)

    For w = 0 To 2
        On Error Resume Next
        Workbooks.Open fileName:=wbName(w), ReadOnly:=True
        Err.Clear
        On Error Resume Next
        With Workbooks.Item(Right(wbName(w), Len(wbName(w)) - InStrRev(wbName(w), _
            Application.PathSeparator))).Worksheets(wsName(w))
            If Err.Number <> 0 Then
                Err.Clear
                On Error GoTo 0
                MsgBox "Could not open workbook file " & w + 1 & ": '" & wbName(w) & "'"
                CloseAll r
                Exit Sub
            End If
            Set r(w) = .Range(cStart, startColumn & _
                .Range(cStart).SpecialCells(xlCellTypeLastCell).Row)
        End With
    Next w
    On Error GoTo 0

    For w = 0 To 2
        For i = 1 To r(w).Count
            If r(w)(i) <> "" Then
                a = Application.Match(r(w)(i), r((w + 1) Mod 3), 0)
                b = Application.Match(r(w)(i), r((w + 2) Mod 3), 0)
                If w = 0 Then
                    If Not IsError(a) Then
                        If Not IsError(b) Then
                            c(7).Add Array(i, a, b)
                        Else
                            c(6).Add Array(i, a, 0)
                        End If
                    ElseIf Not IsError(b) Then
                        c(5).Add Array(i, 0, b)
                    Else
                        c(3).Add Array(i, 0, 0)
                    End If
                ElseIf w = 1 Then
                    If IsError(b) Then
                        If Not IsError(a) Then
                            c(4).Add Array(0, i, a)
                        Else
                            c(2).Add Array(0, i, 0)
                        End If
                    End If
                ElseIf IsError(a) And IsError(b) Then
                   c(1).Add Array(0, 0, i)
                End If
            End If
        Next i
    Next w
    z = 3
    With ThisWorkbook.Worksheets(outputSheet).Range("A1")
        For w = 0 To 2
             .Cells(1, w * 5 + 1) = r(w).Parent.Parent.Name
        Next w
        For w = 0 To 2
            For j = 1 To 3
                .Cells(2, w * 5 + j) = r(w).Cells(0, j) ' column header
            Next j
        Next w
        z = 3
        For i = 7 To 1 Step -1
            For Each v In c(i)
                For w = 0 To 2
                    If v(w) <> 0 Then
                        For j = 1 To 3
                            .Cells(z, w * 5 + j) = r(w).Cells(v(w), j)
                        Next j
                    End If
                Next w
                z = z + 1
            Next v
        Next i
    End With
    CloseAll r
End Sub

Private Sub CloseAll(ByRef r() As Range)
    Dim w As Variant
    For Each w In r
        If Not w Is Nothing Then
            With w.Parent.Parent
                On Error Resume Next
                If .Saved Then .Close
            End With
        End If
    Next w
End Sub