Excel如何高效汇总多个工作簿数据？一文给你讲清楚！【附完整的VBA代码、使用视频】

2024-05-24 07:46| 来源: 网络整理| 查看: 265

一、汇总工作簿，需要避免哪些坑？

VBA汇总多个工作簿，主要涉及到2个需要注意的问题？

1个是汇总的工作簿的格式是否一致？

1个是汇总的工作表是否包含标题行？

以上2个问题，关乎到汇总数据的成功与否？首先，格式不一致，汇总的数据是混乱不堪的，汇总的数据根本用不了。其次，标题行不特别说明，汇总的数据包含多个标题行，也是混乱没法用。所以，使用VBA汇总工作簿的时候，需要特别注意。

二、如何编写VBA汇总工作簿的程序？

汇总工作簿，又可以细分为两种，下面分别详细介绍每一种汇总的方法和代码：

1、第1种，把N个工作簿，汇总到1个工作簿

【难度系数：⭐️⭐️】

案例：把下面10个工作簿的工作表汇总到1个工作簿

汇总后的工作簿，效果如下：

操作视频：

https://www.zhihu.com/video/1655487718032310272

完整VBA代码：

Sub 合并工作簿1() Dim sht As Worksheet, PathStr$ Dim file() As String, FileStr$, n%, k% Dim wkb_汇总 As Workbook, shtCount%, namess$, NewshtName$, xx%, yy%, x%, y% Application.ScreenUpdating = False Call 获取文件夹路径(PathStr) '获取文件夹的存储路径 FileStr = Dir(PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & "*.xls*") While Len(FileStr) > 0 n = n + 1 ReDim Preserve file(1 To n) file(n) = PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & FileStr '获取待汇总文件的路径 FileStr = Dir() Wend If n = 0 Then MsgBox "没发现excel文件": Exit Sub Set wkb_汇总 = ThisWorkbook With wkb_汇总 '遍历每个目标工作簿： For k = 1 To n .Sheets.Add After:=.Sheets(.Sheets.Count) '汇总工作簿增加子表 namess = Dir(file(k)) '获取待汇总工作簿的文件路径和名称 Workbooks.Open Filename:=file(k), UpdateLinks:=0 '打开目标工作簿，不提示外部链接公式更新 With Workbooks(namess).Sheets(1) '目标工作簿数据复制到汇总工作簿 NewshtName = ActiveSheet.Name '针对工作表数据区域复制数据： wkb_汇总.ActiveSheet.Name = NewshtName .UsedRange.Copy wkb_汇总.ActiveSheet.Cells(1, 1) End With Workbooks(namess).Close False Next End With Sheets("运行模板").Activate Application.ScreenUpdating = True MsgBox "不同工作簿的已完成合并！" & " 合并了：" & n & " 个工作簿。", vbInformation, "温馨提示！" End Sub Private Sub 获取文件夹路径(PathStr As String) With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then PathStr = .SelectedItems(1) Else Exit Sub End If End With PathStr = PathStr & IIf(Right(PathStr, 1) = "\", "", "\") End Sub

代码解析：

主程序：Sub 合并工作簿1，实现复制汇总功能

子程序：Private Sub 获取文件夹路径，实现文件夹路径的读取，为主程序提供文件路径数据。

核心代码：

处理过程如下：

在汇总工作簿追加1个新的子表，然后打开需要汇总的数据源工作簿，接着复制全部数据区域的数据，粘贴到汇总工作簿的新子表，最后关闭数据源工作簿，完成整个汇总过程。

.Sheets.Add After:=.Sheets(.Sheets.Count) '汇总工作簿增加子表 namess = Dir(file(k)) '获取待汇总工作簿的文件路径和名称 Workbooks.Open Filename:=file(k), UpdateLinks:=0 '打开目标工作簿，不提示外部链接公式更新 With Workbooks(namess).Sheets(1) '目标工作簿数据复制到汇总工作簿 NewshtName = ActiveSheet.Name '针对工作表数据区域复制数据： wkb_汇总.ActiveSheet.Name = NewshtName .UsedRange.Copy wkb_汇总.ActiveSheet.Cells(1, 1) End With Workbooks(namess).Close False2、第2种，把N个工作簿中，具有相同格式的1个工作表，汇总到1个工作簿的1个子表

【难度系数：⭐️⭐️⭐️】

案例：把下面10个工作簿的工作表汇总到1个工作表

汇总后的工作表，效果如下：

操作视频：

https://www.zhihu.com/video/1655495786367541248

完整VBA代码：

Sub 合并工作簿2() Dim sht As Worksheet, PathStr$ Dim file() As String, FileStr$, n%, k% Dim wkb_汇总 As Workbook, sht_汇总 As Worksheet, shtCount%, namess$, NewshtName$, xx%, yy%, x%, y% Dim iRow As Long, Rows_Title% Application.ScreenUpdating = False Call 获取文件夹路径(PathStr) '获取文件夹的存储路径 FileStr = Dir(PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & "*.xls*") While Len(FileStr) > 0 n = n + 1 ReDim Preserve file(1 To n) file(n) = PathStr & IIf(Right(PathStr, 1) = "\", "", "\") & FileStr '获取待汇总文件的路径 FileStr = Dir() Wend If n = 0 Then MsgBox "没发现excel文件": Exit Sub '输入汇总的数据标题行数： Rows_Title = Application.InputBox("请输入标题行数，标题行不参与合并：", "操作提示！", 1, , , , , 1) Set wkb_汇总 = ThisWorkbook With wkb_汇总 .Sheets.Add After:=.Sheets(.Sheets.Count) '汇总工作簿-新增1个子表存放汇总数据 ActiveSheet.Name = "汇总数据" Set sht_汇总 = wkb_汇总.Sheets("汇总数据") '遍历每个目标工作簿： For k = 1 To n iRow = sht_汇总.Range("a" & Rows.Count).End(xlUp).Row namess = Dir(file(k)) '获取待汇总工作簿的文件路径和名称 Workbooks.Open Filename:=file(k), UpdateLinks:=0 '打开目标工作簿，不提示外部链接公式更新 With Workbooks(namess).Sheets(1) '目标工作簿数据复制到汇总工作簿 '针对工作表数据区域复制数据： xx = .UsedRange.Rows.Count yy = .UsedRange.Columns.Count If k = 1 Then '第1个工作簿连同标题行一起复制，第2个工作簿开始，只复制内容，不复制标题 .UsedRange.Copy sht_汇总.Cells(iRow + 1, 1) Else .Range("A" & Rows_Title + 1).Resize(xx - Rows_Title, yy).Copy sht_汇总.Cells(iRow + 1, 1) End If End With Workbooks(namess).Close False Next sht_汇总.Rows(1).Delete End With Sheets("运行模板").Activate Application.ScreenUpdating = True MsgBox "不同工作簿的已完成合并！" & " 合并了：" & n & " 个工作簿。", vbInformation, "温馨提示！" End Sub Private Sub 获取文件夹路径(PathStr As String) With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then PathStr = .SelectedItems(1) Else Exit Sub End If End With PathStr = PathStr & IIf(Right(PathStr, 1) = "\", "", "\") End Sub

代码解析：

主程序：Sub 合并工作簿2，实现复制汇总功能

子程序：Private Sub 获取文件夹路径，实现文件夹路径的读取，为主程序提供文件路径数据。

核心代码：

处理过程如下：

遍历待汇总的每个工作簿，获取数据源子表的数据范围区域大小，xx行，yy列，第1次完整复制数据源包含标题，第2次开始只复制数据源除标题行之外的数据，完成1个工作簿的复制粘贴之后，关闭数据源工作簿，完成1个工作簿数据的汇总过程。

For k = 1 To n iRow = sht_汇总.Range("a" & Rows.Count).End(xlUp).Row namess = Dir(file(k)) '获取待汇总工作簿的文件路径和名称 Workbooks.Open Filename:=file(k), UpdateLinks:=0 '打开目标工作簿，不提示外部链接公式更新 With Workbooks(namess).Sheets(1) '目标工作簿数据复制到汇总工作簿 '针对工作表数据区域复制数据： xx = .UsedRange.Rows.Count yy = .UsedRange.Columns.Count If k = 1 Then '第1个工作簿连同标题行一起复制，第2个工作簿开始，只复制内容，不复制标题 .UsedRange.Copy sht_汇总.Cells(iRow + 1, 1) Else .Range("A" & Rows_Title + 1).Resize(xx - Rows_Title, yy).Copy sht_汇总.Cells(iRow + 1, 1) End If End With Workbooks(namess).Close False Next三、应用小结

汇总多个工作簿数据，应用到的VBA知识点：

Dir函数遍历每个文件InputBox函数，作为简易的输入交互界面，运行过程手段输入指定的数据Workbooks.Open，打开工作簿.UsedRange.Copy，数据复制到目标位置

另外，使用本期分享的汇总模板汇总数据到一个工作表，需要注意汇总文件的格式是否一致？如果不一致，会导致汇总的数据出现混乱错位的问题！

四、更多VBA及Excel干货知识学习1、SQL基础知识入门教程：2、VBA基础知识入门教程：3、Excel插件制作入门教程：4、VBA提升应用知识教程：5、Excel+VBA实战应用案例教程：

更多Excel、VBA、SQL干货技能知识，请关注，点击主页查看： @职场老鸟

【本文地址】

公司简介

联系我们