利用 VBA 批量合并 EXCEL 文件

一、需求

 

工作上需要将 59个 Excel 文件合并为一个文件后进行分析，这些文件结构完全一样，文件名有规律，文件内容为简单的带有标题行的数据表，每一行为一条数据。现需要将这些文件合并为一个文件，之后利用Excel的数据分析功能进行综合分析。

 

二、实现

 

网上搜了一些文章，都是提供了一些思路，并没有一个完整的范例，最简单的做法是利用VBA模拟人工重复进行“打开子文件-->选择-->复制-->关闭-->粘贴到主文件”操作。

 

由于对VBA不熟，只能自己摸索了，首先打开Excel的“录制宏”功能，手动执行这个功能，然后参考Excel自身提供的函数，改造出了如下代码：

 

 

Sub Copy_all()

    Dim i   As Long            ' 循环变量

    Dim min As Long            ' 文件名中变化量的最小数值

    Dim max As Long            ' 文件名中变化量的最大数值

   

    Dim insert_row As Long     ' 合并文件中的粘贴位置

    Dim first_row  As Long     ' 待合并文件的最前单元格位置

   

    Dim have_title As Boolean  ' 待合并的文件中是否含有标题，

                               ' 如果含有，除第一个文件外从第二行开始拷贝

    Dim filename As String     ' 构造文件名

   

    Application.DisplayAlerts = False

   

    ' 文件名从 page1_of_page59.xls 到 page59_of_page59.xls

    min = 1

    max = 59

    insert_row = 1             ' 初始化，从第一行开始存放

    have_title = True

           

    For i = min To max

        ' 构造文件名并打开文件（Excel 的字符串合并还是很简单的）

        filename = "H:/Info /page" & i & "_of_page59.xls" 

        Workbooks.Open filename:=filename

 

        If have_title Then

            ' 带有标题行，从第1行或第2行一直选择到最后一行

            If i = min Then

                first_row = 1   ' 第一个文件，包含标题行拷贝

            Else

                first_row = 2   ' 其余文件从第二行开始拷贝

            End If

 

            Range("A"&first_row, Cells.SpecialCells(xlCellTypeLastCell)).Select

        Else

            ' 不带标题行，全文选择

            Range("A1", Cells.SpecialCells(xlCellTypeLastCell)).Select

        End If

 

        ' 复制所选到剪贴板，并关闭子文件

        Selection.Copy

        ActiveWindow.Close

 

        ' 确定需要粘贴的位置，将子文件中的内容粘贴到主文件

        Range("A" & insert_row).Select           

        ActiveSheet.Paste

 

        ' 更新主文件中插入的位置

        insert_row = Cells.SpecialCells(xlCellTypeLastCell).row + 1

    Next

   

End Sub

 

 

说明：

1. 合并后的文件成为“主文件”，待合并的文件成为“子文件”；
2. Cells.SpecialCells(xlCellTypeLastCell)的功能为选择最右下角的非空白单元格；
3. 本此操作文件的文件名比较规范，可以直接用循环变量进行转化，如果文件名不规律可参考附录，时间关系不在整合到代码中；

三、应用

 

网上搜搜“Excel文件 合并”，基本都是有类似需求的应用，比如多人整理后的报表合并等，当子文件数量较少时比较容易操作，当数量较大时。。。。还是用这个 VBA 吧 :)
附录 - 文件遍历参考代码

Sub test()

    Dim sFolder As String

    Dim wb As Workbook

    Dim i As Long

 

    With Application.FileSearch

        .NewSearch

        .LookIn = "D:/test"

        .SearchSubFolders = True

        .Filename = "*.xls"

        .FileType = msoFileTypeExcelWorkbooks

        If .Execute() > 0 Then

           For i = 1 To .FoundFiles.Count

               On Error Resume Next

               Set wb = Workbooks.Open(Filename:=.FoundFiles(i))

           Next i

       Else

            MsgBox "Folder " & sFolder & " contains no required files"

       End If

    End With

Exit Sub