诸君晚上好，今天我们聊如何汇总指定文件夹下多个工作簿的数据到总表。
这事儿常用的方法有三种，一种是SQL语句，一种是Power Query，还有一种就是VBA了。
相比前两种方法，VBA有更好的灵活性。
举栗，它可以允许标题行存在合并单元格，可以允许标题行存在多行，甚至可以允许数据明细区域有乱七八糟的合并单元格……等等。
不过，面对过于复杂的问题需要对代码细节作对应的调整……这也就需要小伙伴们不但有代码阅读能力，也要有一定的代码调整能力……
相比之下Power Query就是傻瓜式操作了……
……打住，星光俺扯远了，俺们这是VBA编程学习与实践公众号……
照例动画操作：
代码如下：
Sub Collectwk()
'ExcelHome VBA编程学习与实践
Dim Trow&, k&, arr, brr, i&, j&, book&, a&
Dim p$, f$
Application.ScreenUpdating = False '关闭屏幕更新
On Error Resume Next '忽略代码运行中可能出现的错误继续运行
'
With Application.FileDialog(msoFileDialogFolderPicker)
'取得用户选择的文件夹路径
.AllowMultiSelect = False
If .Show Then
p = .SelectedItems(1)
Else
Exit Sub
End If
End With
If Right(p, 1) <> '\' Then p = p & '\'
'
Trow = Val(InputBox('请输入标题的行数', '提醒'))
If Trow < 0 Then MsgBox '标题行数不能为负数。', 64, '警告': Exit Sub
Cells.ClearContents
Cells.NumberFormat = '@'
'清空当前表数据并设置单元格格式为文本
'
f = Dir(p & '*.xls') '开始遍历工作簿，并将每个工作簿的第一张工作表数据汇总
Do While f <> ''
If f <> ThisWorkbook.Name Then '避免同名文件重复打开出错
With GetObject(p & f)
'以'只读'形式读取文件时，使用getobject方法会比workbooks.open稍快
arr = .Sheets(1).UsedRange '数据区域读入数组arr
book = book 1 '标记一下是否首个Sheet
If book = 1 Then
ReDim brr(1 To 200000, 1 To UBound(arr, 2))
'如果是首个表格，则声明一个结果数组,20万行
a = 1
Else
a = Trow 1 '遍历读取arr数组时扣掉标题行
End If
For i = a To UBound(arr) '遍历行
k = k 1 '累加记录条数
For j = 1 To UBound(brr, 2) '遍历列
brr(k, j) = arr(i, j)
Next
Next
.Close False '关闭工作簿
End With
End If
f = Dir '下一个表格
Loop
If k > 0 Then
[a1].Resize(k, UBound(brr, 2)) = brr
MsgBox '汇总完成。'
End If
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
绕口令：
该段代码只是汇总指定文件夹下每个工作簿的第一张工作表的数据，下期我们再分享如何汇总指定文件夹下每个工作簿多个工作表表名包含某个关键词数据的代码——能一口气读完这段话我服~
一码不扫，
可以扫天下？
ExcelHome
VBA编程学习与实践
联系客服
