【VBAPlanet】如何灵活快捷的合并工作簿

欢迎来到VBAPlanet！
在大数据时代，很多公司的数据都是从数据库中取出来。然而往往会因为数据量过大而分为几个工作簿导出，我们想进一步统计分析数据就需要把各个工作簿的数据合并到一个工作表中。当然，类似的场景还有很多，今天就跟你分享一个灵活快捷的合并工作簿的方法，接招吧。

下面以英雄明细表为例，我们要把在同一文件夹中不同职业的英雄明细工作簿中的数据汇总到同一工作表中。（注意，把要汇总的工作簿事先单独放到一个文件夹中）

这些工作簿除了保存的数据不同，其他地方都是相同的，它们的结构如下图所示。

为了更加灵活便捷的操作，我们打算分两步操作。

第一步，创建“汇总表.xlsx”工作簿

Sub A创建汇总表()
Dim wb As Workbook,strPath As String
Set wb = Workbooks.Add  ' 新建一个工作簿，并将其赋给变量wb
Worksheets.Add Count:=1  ' 新建1个工作表，工作簿自带一个工作表，不新建工作表也可以
wb.Worksheets(1).Name = "汇总表"  ' 将第一个工作表命名为“汇总表”
With Application.FileDialog(msoFileDialogFolderPicker)  ' 将选择的文件夹路径赋值给strPath
If .Show Then
strPath = .SelectedItems(1)
Else
Exit Sub
End If
End With
wb.SaveAs strPath & "\汇总表.xlsx"  ' 保存新建的工作簿保存到指定目录中
Set wb = Nothing  ' 释放wb对象
MsgBox "汇总表已创建", 64  ' 弹窗提示
End Sub

效果演示如下图

第二步，汇总数据

Sub 汇总数据()
Dim wb As Workbook, sht_summary As Worksheet, sht_detail As Worksheet
Dim file_name1 As String, file_name2 As String, num As Long, arr As Variant
Application.ScreenUpdating = False  ' 关闭屏幕更新，提高代码运行效率
Set sht_summary = ActiveWorkbook.Worksheets(1)  '将当前汇总表赋值给对象sht_summary
sht_summary.Select  ' 选中sht1
With sht_summary
.Rows("1:1048576").ClearContents  ' 清除表中原有数据
.Range("A1:H1") = Array("id", "name", "hp_max", "mp_max", "attack_max", "defense_max", "attack_range", "role_main")  ' 设置表头
.Range("A:H").NumberFormatLocal = "@"   'A列到H列设置为文本格式，避免文本数值变形
End With
file_name1 = Dir(ActiveWorkbook.Path & "\*.xlsx")     '使用Dir函数遍历文件夹中格式是“xlsx”的工作簿
Do While file_name1 <> ""
If file_name1 <> ActiveWorkbook.Name Then
file_name2 = ActiveWorkbook.Path & "\" & file_name1  '将要获取的明细工作簿名称赋给变量file_name2
Set wb = GetObject(file_name2)  ' 将变量file_name2代表的明细工作簿赋值给对象wb
Set sht_detail = wb.Worksheets(1)  ' 将工作簿中第一个工作表赋值给对象sht_detail
num = sht_summary.Range("A1").CurrentRegion.Rows.Count + 1  ' 取汇总表中第一条空行行号
' 将明细表中要汇总的数据保存在数组arr中
arr = sht_detail.Range(sht_detail.Cells(2, "A"), sht_detail.Cells(1048576, "H").End(xlUp))
' 将数组arr中的数据写入汇总表
sht_summary.Cells(num, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
wb.Close SaveChanges:=False  ' 关闭当前明细工作簿,不保存修改
End If
file_name1 = Dir  ' 用Dir函数取得其他文件名，并赋给变量
Loop
' 将汇总表中的文本型数字转换为数字型数字，便于后续统计
With sht_summary.Range("C:F")
.NumberFormatLocal = "G/通用格式"
.Value = .Value
End With
' 释放对象
Set sht_summary = Nothing
Set wb = Nothing
Set sht_detail = Nothing
Application.ScreenUpdating = True  ' 恢复屏幕更新
MsgBox "数据汇总完毕", 64  ' 弹窗提示
End Sub

在刚创建的汇总表中，点击“开发工具-宏”，选择“汇总数据”，点击运行。（此时要确保存放代码的“汇总数据工作簿”保持打开状态，这样才能运行宏）
演示效果如下

禅定时刻
注意数字数据变形问题，可以先把数据设置为文本格式。

案例文件:
链接：https://pan.baidu.com/s/1nVx_URQpQc5UTs9Xd-ikNg
提取码：02sh

如果觉得不错，欢迎点赞分享。

• 点赞 1
• 收藏
• 分享
• 文章举报