前景提要
在昨天的学习中，我们也是分享了升级版的工作薄汇总的难度，当字段的顺序不同的时候要如何汇总，我们巧妙的利用了数组的方式来判断数据的位置，从而实现相应的字段再粘贴相应的数据的，当然这仅仅是工作中可能碰到的众多情况中的一种，还有童鞋表示字段顺序不同，其实就是小儿科的事情，他们要汇总的数据，不仅仅字段展示顺序不同，而且字段都不相同呢，这里小编内心只想说一句话：你们之前都是怎么熬过来的
场景模拟
我们还是继续只用之前的数据模型吧，我们还是以京东的产品为例子，我们对数据做一些更改，我们将产品2的数据替换成为手机的数据
image.png
为了效果明显一点，我们再更改一个数据源，把香港的数据源中产品3替换成为TVB
image.png
好，通过这番更改，我们再处理数据的时候，就不仅仅是要处理字段顺序的情况了，而且还有字段也不同的情况，难度全面升级，VBA还可以实现吗？
方法分析
方法我们还是来看看正常的手工操作的话，我们需要如何实现，我们需要判断目标工作薄的表头和总工作薄的表头是否一致，在上节我们学习了如果数据顺序不一致的话，我们可以通过数组方式来找到对应的位置，那么今天的情况字段都不相同，我们还可以通过数字的方式来实现吗？当然可以，不过这里我们需要灵活一点，做出一些调整，具体的看代码
代码区
Sub test()
Dim pathn, sth As Workbook, rng As Range, rng1 As Range, sbook As Workbook, arrT, k&
k = 0
pathn = ThisWorkbook.Path
Set sbook = ThisWorkbook
f = 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 If
line:
f = Dir()
Loop
End Sub
我们来看看最终的效果
image.png
产品这一列数据都是正常的，同时我们新增加的两个测试时产品，手机和TVB的相关数据都已经成功的汇总到了总数居里面，非常完美的实现了我们的要求
单独看看这两份数据的内容，完美，应该空的地方都空， 应该有数据的地方也正常有数据。nice
image.png
image.png
代码分析
其实今天的代码并么有增加太多的知识点，基本上都是在上节的代码的基础上进行调整和更改的，改动比较大的地方就是增加了一个判断
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).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)
这一段是本段代码中最难以理解的部分，因为我们的数据源中，总计那一列的数据应该是放在最后面的，所以我们增加的字段都应该放在总计这一列的前面，所以这里就需要利用数组的动态添加和重新赋值，我们将原来的总计这个字段对应的位置让给新增加的字段的位置，然后把新增加的那一列的数据替换成为总计，这里比较绕，大家要多理解下，来截图看看实际效果
这是替换之前的数组的状态
image.png
第5个位置是总结，新增加的列在数组中是空白的
来看看替换后的效果
image.png
成功的完成了数据的位置的替换和数组的更新
最终的状态是这样的
image.png
网友评论