1. '功能：不同表头Excel文件合并
    2. '作者：E精精
    3. '下载：公众号- Excel办公实战
    4. '-------------------------------------------------------------------
    5. Sub ComData()
    6.     Dim sPath As String
    7.     '选择文件夹
    8.     With Application.FileDialog(msoFileDialogFolderPicker)
    9.         If .Show Then
    10.             sPath = .SelectedItems(1)
    11.             sPath = sPath & IIf(VBA.Right(sPath, 1) = "\", "", "\")
    12.         Else
    13.             End
    14.         End If
    15.     End With
    17.     Dim file As String, ShtCount As Long
    18.     Dim dTitle As Object, dData As Object
    19.     Dim Sht As Worksheet, wb As Workbook
    20.     file = Dir(sPath & "*.xl*")
    21.     Set dTitle = CreateObject("Scripting.dictionary")
    22.     Set dData = CreateObject("Scripting.dictionary")
    24.     Dim ShtName As String, wbName As String
    26.     t = Timer
    27.     '标题和数据分别装入字典备用
    28.     Application.ScreenUpdating = False
    29.     Do While Len(file) > 0
    30.         Set wb = Workbooks.Open(sPath & file, False, True)
    31.         For Each Sht In wb.Worksheets
    32.             ShtCount = ShtCount + 1
    33.             arr = Sht.Range("A1").CurrentRegion.Value
    34.             ShtName = Sht.Name '工作表名称
    35.             wbName = Split(wb.Name, ".")(0) '文件名
    36.             dData(wbName & "|" & ShtName) = arr
    37.             For i = 1 To UBound(arr, 2)
    38.                 If Not dTitle.exists(arr(1, i)) Then
    39.                    k = k + 1
    40.                    dTitle(arr(1, i)) = k
    41.                 End If
    42.             Next
    43.         Next
    45.         wb.Close 0
    46.         file = Dir
    47.     Loop
    48.     Application.ScreenUpdating = True
    50.     Dim brr()
    51.     '+2 文件名+表名
    52.     ReDim brr(1 To 100000, 1 To dTitle.Count + 2)
    54.     For Each eve In dData.keys()
    55.         arr = dData(eve)
    56.         For i = 2 To UBound(arr)
    57.             n = n + 1
    58.             tp = Split(eve, "|")
    59.             brr(n, 1) = tp(0) '文件名
    60.             brr(n, 2) = tp(1) '表名
    61.             For j = 1 To UBound(arr, 2)
    62.                 brr(n, dTitle(arr(1, j)) + 2) = arr(i, j)
    63.             Next
    64.         Next
    65.     Next
    67.     '写入汇总表，没有的自己建一个
    68.     With Sheets("汇总表")
    69.         .Cells.Clear
    70.         .Range("A1:B1") = Array("文件名", "表名")
    71.         .Range("C1").Resize(1, dTitle.Count) = dTitle.keys()
    72.         .Range("A2").Resize(n, dTitle.Count + 2) = brr
    73.     End With
    75.     MsgBox "汇总完成！共汇总：" & ShtCount & "个表！" _
    76.     & vbCrLf & "用时:" & Format(Timer - t, "0.00s")
    77. End Sub