返回目录：excel表格制作
前景提要(）
在进行数据汇总的过程中，不同的场景下，总会有各种不同的需求，随着现在很多公司规模不断的状态，数据报表字段要求也是越来越多，不同的部分不同的职位要求各不相同，导致报表字段越来越大，但是针对个人来说可能真正需要的就是某个报表中的几列数据而已，如果正好要汇总的数据又在很多个报表中，那么我们如何针对某个报表某几列数据进行汇总呢？
场景模拟
假设我们现在有多个工作薄，工作薄的内容是某班次最近三周考试成绩，同样的表我们复制多份，同时为了方便区分，我们将第一周的姓名换成A开头，其他几周的都不是A开头，方便区分
我们需要做的就是将A2这个表的数据中，python和VBA这两个数据列进行汇总，当然我们还还需要加上姓名，就是总共三列，排除总分这一列数据。
代码区
假如我们在汇总的时候，我们还需要改变一下顺序，将python的成绩放在前面,VBA的成绩放在后面，来我们试下
Sub test()
Dim pathn$, strings$, arr, rng As Range, arrt(), tsth As Worksheet
Set tsth = ActiveSheet
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "请选择要合并的工作薄所在文件夹"
If .Show = -1 Then
pathn = .SelectedItems(1)
End If
End With
strings = Application.InputBox("请输入要单独合并的列名，用英文逗号隔开", "列名的 选择", , , , , , 3)
arr = Split(strings, ",")
f = Dir(pathn & "\\")
k = 0
Do While f <> ""
Workbooks.Open pathn & "\\" & f
For Each sth In ActiveWorkbook.Worksheets
k = k + 1
If k = 1 Then
For i = 0 To UBound(arr)
With sth.UsedRange
l = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Find(arr(i), , , xlWhole)
If Not rng Is Nothing Then
num = rng.Column
ReDim Preserve arrt(1 To UBound(arr) + 1, 1 To l)
For j = 1 To l
arrt(i + 1, j) = sth.Cells(j, num)
Next j
End If
End With
Next i
Else
l1 = UBound(arrt, 2)
ReDim Preserve arrt(1 To UBound(arr) + 1, 1 To l + UBound(arrt, 2))
For i = 0 To UBound(arr)
With sth.UsedRange
l = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Find(arr(i), , , xlWhole)
If Not rng Is Nothing Then
num = rng.Column
For j = 1 To l
arrt(i + 1, l1 + j) = sth.Cells(j, num)
Next j
End If
End With
Next i
End If
Next sth
ActiveWorkbook.Close False
f = Dir()
Loop
ActiveSheet.Cells(1, 1).Resize(UBound(arrt, 2), UBound(arrt)) = WorksheetFunction.Transpose(arrt)
End Sub
首先选择文件夹
然后输入我们想要汇总的列名称，这里不要求顺序，但是输入的顺序就是我们展示结果的顺序
然后我们静等程序运行的结果
只汇总了第一周也就是A所在的表的数据，同时列名的展示也按照我们的需要进行了重新排序，将python的结果展示在了VBA的前面，完美
代码分析
前面选择文件夹的代码就不做解释了，都非常的简单，并且我们已经写过很多次了。
strings = Application.InputBox("请输入要单独合并的列名，用英文逗号隔开", "列名的 选择", , , , , , 3)
这里是运用inputbox方式来进行交互的窗体构造，很多的小伙伴在之前也是私信过我，为什么这里一定要用英文逗号隔开，其实这个并不是硬性的要求，你也可以用中文的逗号或者是分好等其他的方式来进行分割，只要保证你的分隔符和下面这句代码的第二个参数保持一致就可以的
arr = Split(strings, ",")
之所以选择英文，因为我们写代码的时候一般都是用英文输入法的，所以为了方便就限制下，不管限制还是不限制，最好都说明下，以免其他的使用者不清楚
split方法拆分之后得到的就是一个数组，这一点大家也要注意。
然后又来到了数组的使用了，今天我们还是将主要精力集中在数组这里。
首先依然是要区分第一次进行汇总，如果是第一次，就非常的简单了。
For i = 0 To UBound(arr)
With sth.UsedRange
l = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = .Find(arr(i), , , xlWhole)
If Not rng Is Nothing Then
num = rng.Column
ReDim Preserve arrt(1 To UBound(arr) + 1, 1 To l)
For j = 1 To l
arrt(i + 1, j) = sth.Cells(j, num)
Next j
End If
End With
Next i
我们这里依然是用动态数组，因为我们也不知道最终会有多少数据，但是有一点是确定的，那就是数组的列数，因为我们需要的列数已经在最初输入的时候就决定了，不确定的就是行数，所以我们构造的数组应该是，已行数为下标的多维数组
完成第一个工作薄的统计之后，我们应该得到的是一个3行10列数组，来看看效果
三行分别对应我们表格中的三个字段
10 则是对应着当前工作表总共有多少行
然后进入第二个工作薄，这时候就需要再变化一下了，我们得到的数据是要在当前数组的行数下标的基础上继续累加的，当前的行数下标怎么算
UBound(arrt, 2)
那么要增加多少行呢？就是当前工作表总共有多少行，两个代码合起来就是这样的
l1 = UBound(arrt, 2)
ReDim Preserve arrt(1 To UBound(arr) + 1, 1 To l + UBound(arrt, 2))
是不是很好理解
=======================================================
本节课的案例源码已经上传，需要的小伙伴们后台私信“7-25-1”即可，希望大家多多支持~~
说明一下，下载了源码文件之后，要放在需要合并的文件夹内才可以正常执行
好了~明晚19：00，准时再见。