利用 VBA 批量合併 EXCEL 檔案
（很久沒有寫什麼了，今天突然需要解決一個 Office 的問題，有很多人有同樣的問題，但是網上半天也沒有找到完整的答案，只好自己做出一份答案，跟大家分享下吧，也算是活動活動）
一、需求<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" />
工作上需要將 59個 Excel 檔案合併為一個檔案後進行分析，這些檔案結構完全一樣，檔名有規律，檔案內容為簡單的帶有標題行的資料表，每一行為一條資料。現需要將這些檔案合併為一個檔案，之後利用Excel的資料分析功能進行綜合分析。
二、實現
網上搜了一些文章，都是提供了一些思路，並沒有一個完整的範例，最簡單的做法是利用VBA
由於對VBA不熟，只能自己摸索了，首先開啟Excel的“錄製巨集”功能，手動執行這個功能，然後參考Excel自身提供的函式，改造出瞭如下程式碼：
|
Sub Copy_all() Dim iAsLong' 迴圈變數 Dim min AsLong' 檔名中變化量的最小數值 Dim max AsLong' 檔名中變化量的最大數值 Dim insert_row AsLong' 合併檔案中的貼上位置 Dim first_rowAsLong' 待合併檔案的最前單元格位置 Dim have_title ' 如果含有，除第一個檔案外從第二行開始拷貝 Dim filename AsString' 構造檔名 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' 其餘檔案從第二行開始拷貝 EndIf Range("A"&first_row, Cells.SpecialCells(xlCellTypeLastCell)).Select Else ' 不帶標題行，全文選擇 Range("A1", Cells.SpecialCells(xlCellTypeLastCell)).Select EndIf ' 複製所選到剪貼簿，並關閉子檔案 Selection.Copy ActiveWindow.Close ' 確定需要貼上的位置，將子檔案中的內容貼上到主檔案 Range("A" & insert_row).Select ActiveSheet.Paste ' 更新主檔案中插入的位置 insert_row = Cells.SpecialCells(xlCellTypeLastCell).row + 1 Next EndSub |
說明：
- 合併後的檔案成為“主檔案”，待合併的檔案成為“子檔案”；
- Cells.SpecialCells(xlCellTypeLastCell)的功能為選擇最右下角的非空白單元格；
- 本此操作檔案的檔名比較規範，可以直接用迴圈變數進行轉化，如果檔名不規律可參考附錄，時間關係不在整合到程式碼中；
三、應用
網上搜搜“Excel檔案 合併”，基本都是有類似需求的應用，比如多人整理後的報表合併等，當子檔案數量較少時比較容易操作，當數量較大時。。。。還是用這個 VBA 吧 :)
附錄 - 檔案遍歷參考程式碼
|
Sub test() Dim sFolder AsString Dim wb AsWorkbook Dim i AsLong 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" EndIf EndWith ExitSub |