优秀的编程知识分享平台

网站首页 > 技术文章 正文

VBA合并同文件夹下所有EXCEL文件工作表同构数据(附代码)

nanyue 2025-08-31 06:25:26 技术文章 5 ℃

本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

运行说明

  1. 将此代码复制到Excel的VBA编辑器中(Alt+F11)。
  2. 修改代码中的 folderPath 变量为实际文件夹路径(例如 "C:\Data")。
  3. 确保所有Excel文件(.xls 或 .xlsx)的工作表具有相同的结构(相同的列标题)。
  4. 运行宏(F5或通过Excel的宏菜单)。
  5. 合并结果将生成在名为"Merged_Data_日期时间"的新工作表中。

注意事项

  • 请确保目标文件夹路径正确且可访问。
  • 所有工作表需具有一致的表头结构,以确保合并结果的准确性。
  • 建议备份数据以防意外数据丢失。
  • 代码会自动关闭处理过的Excel文件,以避免内存问题。
  • 如果文件夹中包含其他类型的 .xls* 文件(如 .xlsm),它们也会被处理;如需限制,仅处理 .xls 和 .xlsx,需进一步修改 fileExtension 逻辑。

Tags:

最近发表
标签列表