VBA合并同文件夹下所有EXCEL文件工作表同构数据(附代码)
本VBA代码设计用于合并同一文件夹下所有Excel文件(包括 .xls 和 .xlsx 格式)中结构相同的工作表数据,生成一个包含所有数据的综合工作表。代码通过文件系统对象(FSO)自动遍历指定文件夹中的Excel文件,提取每个工作表的数据并将其合并到新建的工作表中,仅保留一次表头。代码包含详细注释,便于理解和维护,适合需要批量整合Excel数据的场景。运行前,请确保所有工作表具有一致的表头结构,并正确设置文件夹路径,以保证合并结果的准确性和完整性。
Sub MergeExcelFiles()
' 声明变量
Dim fso As Object ' 文件系统对象,用于处理文件夹和文件
Dim folder As Object ' 文件夹对象
Dim file As Object ' 文件对象
Dim wb As Workbook ' 当前处理的Excel文件工作簿对象
Dim ws As Worksheet ' 循环处理的工作表对象
Dim wsMaster As Worksheet ' 合并结果的目标工作表
Dim rng As Range ' 数据范围
Dim lastRow As Long ' 最后一行号
Dim lastCol As Long ' 最后一列号
Dim targetRow As Long ' 目标工作表的当前行号
Dim firstDataRow As Long ' 数据开始行(通常为第2行,跳过表头)
Dim folderPath As String ' 文件夹路径
Dim fileExtension As String ' 文件扩展名
Dim app As Application ' Excel应用程序对象
' 设置错误处理
On Error GoTo ErrorHandler
' 初始化Excel应用程序对象
Set app = Application
' 设置文件夹路径(可修改为实际路径或使用文件夹选择对话框)
folderPath = "C:\YourFolderPath\" ' 请替换为实际文件夹路径
fileExtension = "*.xls*" ' 兼容.xls和.xlsx文件
' 创建文件系统对象
Set fso = CreateObject("Scripting.FileSystemObject")
' 检查文件夹是否存在
If Not fso.FolderExists(folderPath) Then
MsgBox "指定的文件夹路径不存在: " & folderPath, vbCritical
Exit Sub
End If
Set folder = fso.GetFolder(folderPath)
' 初始化当前工作簿
Set wb = ThisWorkbook
' 创建新的目标工作表用于存放合并数据
Set wsMaster = wb.Worksheets.Add(Before:=wb.Worksheets(1))
wsMaster.Name = "Merged_Data_" & Format(Now, "yyyymmdd_hhmmss")
' 初始化目标行的起始位置
targetRow = 1
' 遍历文件夹中的每个Excel文件
For Each file In folder.Files
' 检查文件是否为Excel文件(包括.xls和.xlsx)
If LCase(file.Name) Like LCase(fileExtension) Then
' 打开当前Excel文件
Set wb = app.Workbooks.Open(file.Path)
' 遍历当前工作簿中的每个工作表
For Each ws In wb.Worksheets
' 找到当前工作表的最后一列
lastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column
' 如果是第一个处理的工作表,复制表头
If targetRow = 1 Then
' 复制表头到目标工作表
ws.Range(ws.Cells(1, 1), ws.Cells(1, lastCol)).Copy _
Destination:=wsMaster.Cells(targetRow, 1)
targetRow = targetRow + 1
End If
' 找到当前工作表的最后一行
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
' 设置数据开始行为第2行(假设第1行为表头)
firstDataRow = 2
' 如果有数据(行数大于表头行)
If lastRow >= firstDataRow Then
' 设置数据范围(从第2行到最后一行,所有列)
Set rng = ws.Range(ws.Cells(firstDataRow, 1), ws.Cells(lastRow, lastCol))
' 复制数据到目标工作表
rng.Copy Destination:=wsMaster.Cells(targetRow, 1)
' 更新目标行号
targetRow = targetRow + rng.Rows.Count
End If
Next ws
' 关闭当前工作簿,不保存更改
wb.Close SaveChanges:=False
End If
Next file
' 自动调整目标工作表列宽
wsMaster.Columns.AutoFit
' 显示完成消息
MsgBox "所有Excel文件的数据已合并到 " & wsMaster.Name, vbInformation
' 清理对象引用
Set wsMaster = Nothing
Set wb = Nothing
Set folder = Nothing
Set fso = Nothing
Set app = Nothing
Exit Sub
ErrorHandler:
' 显示错误信息
MsgBox "发生错误: " & Err.Description, vbCritical
' 清理对象引用
If Not wb Is Nothing Then wb.Close SaveChanges:=False
Set wsMaster = Nothing
Set wb = Nothing
Set folder = Nothing
Set fso = Nothing
Set app = Nothing
End Sub
运行说明
- 将此代码复制到Excel的VBA编辑器中(Alt+F11)。
- 修改代码中的 folderPath 变量为实际文件夹路径(例如 "C:\Data")。
- 确保所有Excel文件(.xls 或 .xlsx)的工作表具有相同的结构(相同的列标题)。
- 运行宏(F5或通过Excel的宏菜单)。
- 合并结果将生成在名为"Merged_Data_日期时间"的新工作表中。
注意事项
- 请确保目标文件夹路径正确且可访问。
- 所有工作表需具有一致的表头结构,以确保合并结果的准确性。
- 建议备份数据以防意外数据丢失。
- 代码会自动关闭处理过的Excel文件,以避免内存问题。
- 如果文件夹中包含其他类型的 .xls* 文件(如 .xlsm),它们也会被处理;如需限制,仅处理 .xls 和 .xlsx,需进一步修改 fileExtension 逻辑。