使用excel中的VBA合并多个excel文件

发布于:2025-02-22 ⋅ 阅读:(13) ⋅ 点赞:(0)

需求是这样的:
在Windows下,用excel文件让多个小组填写了统计信息,现在我需要把收集的多个文件汇总到一个文件中,前三行为标题可以忽略,第四行为收集信息的列名,处理每一行数据的时候,发现某一行的第一列为空将不再复制处理本文件中下面的行。
在office的Excel中视图下面的宏中,创建一个新的宏,并命名为ConsolidateExcelFiles,

Sub ConsolidateExcelFiles()
    Dim FolderPath As String
    Dim FileName As String
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim LastRow As Long
    Dim DestRow As Long
    Dim i As Long
    Dim fd As FileDialog
    Dim FirstFile As Boolean
    Dim HeaderRow As Long
    Dim StartRow As Long

    ' 使用文件对话框选择文件夹路径
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    fd.Title = "选择要合并的文件所在的文件夹"
    If fd.Show = -1 Then
        FolderPath = fd.SelectedItems(1) & "\"
    Else
        MsgBox "未选择文件夹,操作取消。"
        Exit Sub
    End If

    ' 询问用户列名所在的行号
    HeaderRow = Application.InputBox("请输入列名所在的行号:", Type:=1)
    If HeaderRow < 1 Then
        MsgBox "无效的行号,操作取消。"
        Exit Sub
    End If

    ' 创建一个新的工作簿用于汇总
    Set wsDest = ThisWorkbook.Sheets(1)
    DestRow = 1
    FirstFile = True

    ' 获取文件夹中的第一个文件
    FileName = Dir(FolderPath & "*.xls*")

    ' 遍历文件夹中的所有文件
    Do While FileName <> ""
        ' 打开源工作簿
        Set wbSource = Workbooks.Open(FolderPath & FileName)
        Set wsSource = wbSource.Sheets(1)

        ' 找到源工作表的最后一行
        LastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

        ' 如果是第一个文件,复制列名
        If FirstFile Then
            wsSource.Rows(HeaderRow).Copy wsDest.Rows(DestRow)
            DestRow = DestRow + 1
            FirstFile = False
        End If

        ' 从列名行的下一行开始复制数据
        StartRow = HeaderRow + 1
        For i = StartRow To LastRow
            ' 如果第一列为空,则停止处理该文件
            If IsEmpty(wsSource.Cells(i, 1).Value) Then Exit For

            ' 复制数据到目标工作表
            wsSource.Rows(i).Copy wsDest.Rows(DestRow)
            DestRow = DestRow + 1
        Next i

        ' 关闭源工作簿
        wbSource.Close SaveChanges:=False

        ' 获取下一个文件
        FileName = Dir
    Loop

    MsgBox "汇总完成!"
End Sub

这里的VBA脚本通过文件夹选择的方式来选择要合并哪个文件夹下面的Excel文件
在这里插入图片描述
然后输入收集信息表中列名所在的行数:
在这里插入图片描述
最后合并的文件中只会记录一行列名,后面其他重复的列名将会被忽略掉:
在这里插入图片描述

如果需要经常使用,可以将此包含宏的Excel保存为一个xlsm格式的文件,方便后续的使用。