我们有时候需要将在同一个文件夹下的多个工作薄的数据到同一个工作表当中,首先我们需要确认的是这些数据的格式是否具有一致性,如果所有的数据格式都是一样的,那么这个问题就非常好处理了。
数据汇总的方法其实非常多,SQL、Power Qurey法,VBA方法。相比前两种方法,VBA有更好的灵活性。每个的数据处理方法都不一样,做法都不一样。因此我们今天和大家分享的是通过VBA代码来解决这个问题。但是对于我们大部分来说,这个是一件非常痛苦的事情。要么自己的去写代码,要么到网上找代码,然后修改。
照例举一个例子,源数据如下图所示:
数据分为3个工作簿,每个工作薄的第一个表的数据格式都是一致的。
目前我们的需求是将Test文件下的所有工作薄的sheets1的数据汇总到总表中。
我们先看看动画执行的效果:
看了以上的动画,你是不是发现批量操作合并工作薄,其实如此很简单。
您只需要将以下代码复制到Excel的VBE窗口的模块中,然后执行程序即可。
Sub wktest()
Dim Trow&, k&, arr, brr, i&, j&, book&, a&
Dim p$, f$, Rng As Range
With Application.FileDialog(msoFileDialogFolderPicker)
'取得用户选择的文件夹路径
.AllowMultiSelect = False
If .Show Then p = .SelectedItems(1) Else Exit Sub
End With
If Right(p, 1) <> "\" Then p = p & "\"
'
Trow = Val(InputBox("请输入标题的行数", "提醒"))
If Trow < 0 Then MsgBox "标题行数不能为负数。", 64, "警告": Exit Sub
Application.ScreenUpdating = False '关闭屏幕更新
Cells.ClearContents '清空当前表数据
Cells.NumberFormat = "@" '设置单元格格式为文本
ReDim brr(1 To 200000, 1 To 1)
'定义装汇总结果的数组brr,最大行数为20万行
*")
'开始遍历指定文件夹路径下的每个工作簿
Do While f <> ""
If f <> ThisWorkbook.Name Then '避免同名文件重复打开出错
With GetObject(p & f)
'以\'只读\'形式读取文件时,使用getobject方法会比workbooks.open稍快
Set Rng = .Sheets(1).UsedRange
If IsEmpty(Rng) = False Then '如果工作表非空
book = book + 1 '标记一下是否首个Sheet,如果首个sheet,BOOK=1
a = IIf(book = 1, 1, Trow + 1) '遍历读取arr数组时是否扣掉标题行
arr = Rng.Value '数据区域读入数组arr
If UBound(arr, 2) > UBound(brr, 2) Then
'动态调整结果数组brr的最大列数,避免明细表列数不一的情况。
ReDim Preserve brr(1 To 200000, 1 To UBound(arr, 2))
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
End If
.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
以上就是今天要和大家分享的技巧,希望对大家有所帮助,祝各位一天好心情!该段代码只是汇总指定文件夹下每个工作簿的第一张工作表的数据。
唯有不断学习,才能不被淘汰!
Excel中每一个方法都有特定的用途,不是他们没有用处,只是你不了解或者暂时用不着,建议你收藏起来,万一哪天用着呢?
PS:其实Excle2016版本的自带PQ也很容易实现数据汇总。
如果你是新同学,长按下面二维码 - 识别图中二维码 - 关注,就可以每天和我一起学Excel了。