|
以下内容学习连接：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的表头的顺序格式，后边的表列名一致则合并，列名不一致，在最后一列增加新的列
即：
列标题与数据是一一对应的，来自哪个表的数据就对应行标题来自哪个表格列标题汇总了所有的列标题（项目名称），避免了重复数据填充在相应的单元格，没有数据的地方就留空
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
|