關於Excel下通過VBA實現工作簿檔案下工作表的合併
對於普通使用者而言，Excel是一個比較強大的資料處理工具。一般公司的普通職員常使用它來完成資料的錄入分析，但是當面對處理經由多人按統一模板統計完成的錄入資料分析時，資料將分散存放在多個.xlsx檔案下，顯然對這些檔案一個一個分析不止費時費力，而且很大概率因資料重複，導致分析結果並不準確。因此在分析資料之前首先需要將多個.xlsx內的資料合併，再去除重複項，最後進行彙總分析才能得到相對準確的分析結果。但是手動複製貼上多個工作表內容顯得費時費力，也容易存在疏漏，尤其是當.xlsx檔案眾多，且內部sheet表眾多時，重複勞動工作量大，出錯率高。本文所描述的VBA程式正是為解決此問題而構建的。
一、首先考慮如何合併同一.xlsx檔案下的多個sheet表
1、Excel檔案解析
Excel是一個office下的一款視覺化的資料處理工具，其檔案命名為"****.xlsx"或"****.xls"，即每一個Excel檔案的字尾名為".xlsx"或".xls"，新建一個Excel檔案，內部預設存在3個Excel操作工作表。
在office自帶的VBA編輯器下，每一個Excel檔案都是一個Workbook物件，每一個Workbook物件下面都下屬N個Worksheet物件，每一個Worksheet物件下面又是通過N個cell（單元格）組成的。
在合併同一個工作簿下面全部的工作表的資料，主要是通過操作當前Workbook物件下面的多個Worksheet物件來完成合並工作。
2、VBA合併程式碼
2.1合併工作表需要讀取工作表內的全部行數，需注意以下兩種讀取方法的選擇
a.讀取工作表內全部已定義行數
l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l為ts中的工作表有定義列數量+1
b.讀取工作表內不間斷的全部有資料填充的行數
l = ts.Range("A65536").End(xlUp).Column + 1 'l為ts中的工作表A列有效列數量+1
注意其中End(xlUp)相當於按Ctrl+Shift+↓ 用於獲取某一列中被有效資料填充的行
這裡我們選擇使用法b
2.2、合併同一工作簿下所有的工作表
合併同一個Excel檔案下所有的工作表僅需要對工作簿下從第二張工作表開始遍歷所有工作表，將其中包含有效資訊的行全部複製到第一張工作表中。
以下為具體程式碼：
Sub mergeonexls() '將同一個工作簿下的所有工作表全部合併到本工作簿下的第一個工作表中
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long '定義變數/工作簿/工作表/整型
Application.ScreenUpdating = False '遮蔽重新整理，提高執行效率
Application.DisplayAlerts = False '遮蔽變化顯示，提高執行效率
Set t = ThisWorkbook '程式碼所在的工作簿t
Set ts = t.Sheets(1) 'ts為工作簿t中的第1個工作表
For i = 2 To t.Sheets.Count '遍歷工作簿t中出第一個工作表以外的所有工作表（即從第2到n個工作表sheet）
Set wsh = t.Sheets(i) 'wsh為工作簿t中的第i個工作表
l = ts.Range("A65536").End(xlUp).Column + 1 'l為ts中的工作表有效列數量+1
h = ts.Range("A65536").End(xlUp).Row + 1 'h為ts中的工作表有效行數量+1
'l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l為ts中的工作表有定義列數量+1
'h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'h為ts中的工作表有定義行數量+1
'有效行意味著本行存在有資料填充的單元格，有效列同理
'有定義行意味著本行存在著有相關資料規則的單元格（包括資料序列等情況），有定義列同理
If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
wsh.UsedRange.Copy ts.Cells(1, 1)
'如果l=1且h=1，ts工作表首單元格為空，則直接將wsh中的資料寫入ts中
Else
wsh.UsedRange.Copy ts.Cells(h + 1, 1)
'否則從ts的首個無資料填充行開始寫入wsh的資料
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
2.3、多個Excel檔案下每一個工作表一一對應合併需要首先將所需要合併的excel檔案全部選中，然後將目標excel檔案下工作表index與源excel檔案下工作表的index相等的工作表合併（源excel檔案下工作表內容寫在目標excel檔案後）。
具體程式碼如下：
Sub mergeeveryonexls() '將多個工作簿下的工作表依次對應合併到本工作簿下的工作表，即第一張工作表對應合併到第一張，第二張對應合併到第二張……
On Error Resume Next
Dim x As Variant, x1 As Variant, w As Workbook, wsh As Worksheet
Dim t As Workbook, ts As Worksheet, i As Integer, l As Integer, h As Long
'定義變數/工作簿/工作表/整型
Application.ScreenUpdating = False '遮蔽重新整理，提高執行效率
Application.DisplayAlerts = False '遮蔽變化顯示，提高執行效率
x = Application.GetOpenFilename(FileFilter:="Excel檔案 (*.xls; *.xlsx),*.xls; *.xlsx,所有檔案(*.*),*.*", _
Title:="Excel選擇", MultiSelect:=True)
'選擇需要進行合併的工作簿（即excel檔案）集合，可以多選
Set t = ThisWorkbook '程式碼所在的工作簿t
For Each x1 In x '對每一個工作表集合中的工作簿x1
If x1 <> False Then '如果x1存在
Set w = Workbooks.Open(x1) '開啟x1到w
For i = 1 To w.Sheets.Count '遍歷w中所有的工作表（即sheet）
If i > t.Sheets.Count Then t.Sheets.Add After:=t.Sheets(t.Sheets.Count)
'如果工作簿w中工作表數量多於程式碼所在工作簿t中工作表數量,則將w中的工作表直接新增到t中
Set ts = t.Sheets(i) 'ts為工作簿t中的第i個工作表
Set wsh = w.Sheets(i) 'wsh為工作簿t中的第i個工作表
l = ts.Range("A65536").End(xlUp).Column + 1 'l為ts中的工作表有效列數量+1
h = ts.Range("A65536").End(xlUp).Row + 1 'h為ts中的工作表有效行數量+1
'l = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Column 'l為ts中的工作表有定義列數量+1
'h = ts.UsedRange.SpecialCells(xlCellTypeLastCell).Row 'h為ts中的工作表有定義行數量+1
'有效行意味著本行存在有資料填充的單元格，有效列同理
'有定義行意味著本行存在著有相關資料規則的單元格（包括資料序列等情況），有定義列同理
If l = 1 And h = 1 And ts.Cells(1, 1) = "" Then
wsh.UsedRange.Copy ts.Cells(1, 1)
'如果l=1且h=1，ts工作表首單元格為空，則直接將wsh中的資料寫入ts中
Else
wsh.UsedRange.Copy ts.Cells(h + 1, 1)
'否則從ts的首個無資料填充行開始寫入wsh的資料
End If
Next
w.Close
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub