利用 VBA 批量合并 EXCEL 文件

（很久没有写什么了，今天突然需要解决一个 Office 的问题，有很多人有同样的问题，但是网上半天也没有找到完整的答案，只好自己做出一份答案，跟大家分享下吧，也算是活动活动）

 

一、需求

 

工作上需要将 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