EXCEL不同表头的多表合并VBA

以下内容学习连接：https://www.dazhuanlan.com/2019/10/23/5daf62ca917ed/?cf_chl_jschl_tk=b45aabfc01845564414cd15df99773357e2b075d-1583998221-0-AU2bmCw-wjZrAd6gGfVAgxlIoiB8Wv7zJlwYiHkktbJbtjMS9Hdbz77AYZOs9M_23-thCgszRinc8t6CNjli4pJ-jXidocAUGoRwR2N6Ho1701DTfBW4hiBra_vFXDgXiCn7EwsiXnB7yPNMIxfn235AJKwBb59MIp_Xb236p_qvdii-TfQ6zOpr6Z2jDQFS-9gDDrHAql2QtI58xsbjUkyzNK-aQ7pLHDJ1gS7zCFpIyZFIAn8SOnzUzB_P6n97KSrLdwVux88s_3kYj6dNHq09drqLf8itrcpcvu9tpOFtfuOKYEP0eDQhtZy20ofkXw

应用背景

• 同一个EXCEL工作表下有多个表头不一样（顺序/列名不一样）的sheet，需要把所有不一样的sheet合并到一张总表，参考第一个sheet的表头的顺序格式，后边的表列名一致则合并，列名不一致，在最后一列增加新的列

即：

1. 列标题与数据是一一对应的，来自哪个表的数据就对应行标题来自哪个表格
2. 列标题汇总了所有的列标题（项目名称），避免了重复
3. 数据填充在相应的单元格，没有数据的地方就留空

VBA实现代码

Sub combin()
Dim d As Object
Dim newst As Worksheet
Dim sh As Worksheet
Dim m
Dim r, r2
Dim i


Set d = CreateObject("scripting.dictionary")

Set newst = Sheets.Add
newst.Name = "合并"
m = 2
For Each sh In Sheets
    If sh.Name <> "合并" Then
        For i = 1 To sh.UsedRange.Columns.Count
            If Not d.exists(sh.Cells(1, i).Value) Then
                d(sh.Cells(1, i).Value) = m
                m = m + 1
            End If
        Next i
    End If
Next sh

newst.Range("A1") = "工作表"
newst.Range(Cells(1, 2), Cells(1, d.Count + 1)) = d.keys

For Each sh In Sheets
    If sh.Name <> "合并" Then
        r = newst.UsedRange.Rows.Count + 1
        For i = 1 To sh.UsedRange.Columns.Count
            sh.UsedRange.Columns(i).Offset(1).Copy newst.Cells(r, d(sh.Cells(1, i).Value))
        Next i
        r2 = newst.UsedRange.Rows.Count
        newst.Range("A" & r & ":A" & r2) = sh.Name
    End If
Next sh

Set d = Nothing

End Sub