Excel VBA工作薄 5.7难度继续飙升 字段都不同的多个工作薄如何汇总
前景提要
在昨天的学习中，我们也是分享了升级版的工作薄汇总,当字段的顺序不同的时候要如何汇总，我们巧妙的利用了数组的方式来判断数据的位置，当然这仅仅是工作中可能碰到的众多情况中的一种，还有童鞋表示字段顺序不同，其实就是小儿科的事情，他们要汇总的数据，不仅仅字段展示顺序不同，而且字段都不相同呢，一起来看看
场景模拟
我们还是继续使用之前的数据模型吧，我们还是以京东的产品为例子，我们对数据做一些更改，我们将产品2的数据替换成为手机的数据
为了效果明显一点，我们再更改一个数据源，把香港的数据源中产品3替换成为TVB
好，通过这番更改，我们再处理数据的时候，就不仅仅是要处理字段顺序的情况了，而且还有字段也不同的情况，难度全面升级，VBA还可以实现吗？
方法分析
方法我们还是来看看正常的手工操作的话，我们需要如何实现，我们需要判断目标工作薄的表头和总工作薄的表头是否一致，在上节我们学习了如果数据顺序不一致的话，我们可以通过数组方式来找到对应的位置，那么今天的情况字段都不相同，我们还可以通过数字的方式来实现吗？当然可以，不过这里我们需要灵活一点，做出一些调整，具体的看代码
代码区
Sub test()Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT, k&k = 0pathn = ThisWorkbook.PathSet sbook = ThisWorkbookf = Dir(pathn & "\")Do While f <> "" l = Cells(Rows.Count, 1).End(xlUp).Row If f <> "test.xlsm" Then For Each sth In Workbooks If sth.Name = f Then GoTo line End If Next sth '=====汇总工作薄的代码====== k = k + 1 If k = 1 Then Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange rng.Copy sbook.Worksheets(1).Cells(1, 1) Else l1 = Cells(1, Columns.Count).End(xlToLeft).Column arrT = Range(Cells(1, 1), Cells(1, l1)) Workbooks.Open (pathn & "\" & f) Set rng = ActiveSheet.UsedRange arrW = rng.Rows(1) l2 = UBound(arrW, 2) For i = 1 To l2 On Error Resume Next Num = WorksheetFunction.Match(arrW(1, i), arrT, 0) If Err.Number = 0 Then rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num) Else l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column sbook.Worksheets(1).Columns(l3).Insert sbook.Worksheets(1).Cells(1, l3) = arrW(1, i) rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3) ReDim Preserve arrT(1 To 1, 1 To l3 + 1) arrT(1, l3) = arrW(1, i) arrT(1, l3 + 1) = arrW(1, l2) End If Next i End If '=====汇总工作薄的代码====== ActiveWorkbook.Close True End Ifline: f = Dir()LoopEnd Sub我们来看看最终的效果
产品这一列数据都是正常的，同时我们新增加的两个测试时产品，手机和TVB的相关数据都已经成功的汇总到了总数居里面，非常完美的实现了我们的要求
单独看看这两份数据的内容，完美，应该空的地方都空， 应该有数据的地方也正常有数据。nice
代码解析
其实今天的代码并么有增加太多的知识点，基本上都是在上节的代码的基础上进行调整和更改的，改动比较大的地方就是增加了一个判断
If Err.Number = 0 Then rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, Num) Else l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Column sbook.Worksheets(1).Columns(l3).Insert sbook.Worksheets(1).Cells(1, l3) = arrW(1, i) rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3) ReDim Preserve arrT(1 To 1, 1 To l3 + 1) arrT(1, l3) = arrW(1, i) arrT(1, l3 + 1) = arrW(1, l2)End If如果我们要汇总的目标表格中的数据在我们的汇总表中没有对应的字段的话，我们需要增加字段。我们来分解下动作
l3 = sbook.Worksheets(1).Cells(1, Columns.Count).End(xlToLeft).Columnsbook.Worksheets(1).Columns(l3).Insertsbook.Worksheets(1).Cells(1, l3) = arrW(1, i)获取汇总表的行的最下下标，并且新插入一列，同时将这一列的表头设置为我们汇总表中缺失的这个表头
rng.Columns(i).Offset(1, 0).Copy sbook.Worksheets(1).Cells(l + 1, l3)ReDim Preserve arrT(1 To 1, 1 To l3 + 1)arrT(1, l3) = arrW(1, i)arrT(1, l3 + 1) = arrW(1, l2)这一段是本段代码中最难以理解的部分，因为我们的数据源中，总计那一列的数据应该是放在最后面的，所以我们增加的字段都应该放在总计这一列的前面，所以这里就需要利用数组的动态添加和重新赋值，我们将原来的总计这个字段对应的位置让给新增加的字段的位置，然后把新增加的那一列的数据替换成为总计，这里比较绕，大家要多理解下，来截图看看实际效果
这是替换之前的数组的状态
第5个位置是总结，新增加的列在数组中是空白的
来看看替换后的效果
成功的完成了数据的位置的替换和数组的更新
最终的状态是这样的