需求分析
其實這個需求手動操作很好實現，復制所有表格粘貼到同一個表格中。
用代碼也是可以模擬這個操作來實現的。
所以實現的步驟基本就是:
-
獲取同一個文件夾下的所有文件
-
獲取文件中的表格及其內容
-
復制表格中有數據的內容
-
粘貼內容到合適的位置
獲取文件
首先，我百度搜索了【VBA獲取文件夾下所有文件】，找到了個Dir函數，再去Excel的幫助文檔中查Dir函數
Dir函數返回一個
String，用以表示一個文件名、目錄名或文件夾名稱，它必須與指定的模式或文件屬性、或磁盤卷標相匹配。語法
Dir[(pathname[, attributes])]
Dir函數的語法具有以下幾個部分：部分 描述
pathname 可選參數。用來指定文件名的字符串表達式，可能包含目錄或文件夾、以及驅動器。如果沒有找到 pathname，則會返回零長度字符串 ("")。
attributes 可選參數。常數或數值表達式，其總和用來指定文件屬性。如果省略，則會返回匹配 pathname 但不包含屬性的文件。設置值
attributes 參數的設置可為：
常數 值 描述
vbNormal 0 (缺省) 指定沒有屬性的文件。
vbReadOnly 1 指定無屬性的只讀文件
vbHidden 2 指定無屬性的隱藏文件
VbSystem 4 指定無屬性的系統文件 在Macintosh中不可用。
vbVolume 8 指定卷標文件；如果指定了其它屬性，則忽略vbVolume 在Macintosh中不可用。
vbDirectory 16 指定無屬性文件及其路徑和文件夾。
vbAlias 64 指定的文件名是別名，只在Macintosh上可用。
這樣看我還是沒太懂怎么用，但是幫助文檔中還貼心的給了示例
Dim MyFile, MyPath, MyName
' 返回“WIN.INI”(在 Microsoft Windows 中) （如果該文件存在）。
MyFile = Dir("C:\WINDOWS\WIN.ini")
' 返回帶指定擴展名的文件名。如果超過一個 *.ini 文件存在，
' 函數將返回按條件第一個找到的文件名。
MyFile = Dir("C:\WINDOWS\*.ini")
' 若第二次調用 Dir 函數，但不帶任何參數，則函數將返回同一目錄下的下一個 *.ini 文件。
MyFile = Dir
' 返回找到的第一個隱式 *.TXT 文件。
MyFile = Dir("*.TXT", vbHidden)
' 顯示 C:\ 目錄下的名稱。
MyPath = "c:\" ' 指定路徑。
MyName = Dir(MyPath, vbDirectory) ' 找尋第一項。
Do While MyName <> "" ' 開始循環。
' 跳過當前的目錄及上層目錄。
If MyName <> "." And MyName <> ".." Then
' 使用位比較來確定 MyName 代表一目錄。
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
Debug.Print MyName ' 如果它是一個目錄，將其名稱顯示出來。
End If
End If
MyName = Dir ' 查找下一個目錄。
Loop
對於從事編程的我來說，這段示例挺清晰明了了，Dir("C:\WINDOWS\WIN.ini")中使用了絕對路徑，這樣並不是很靈活，所以我又百度了【VBA獲取當前文件路徑】，找到了ThisWorkbook對象的Path屬性，出於習慣，我編了一小段代碼驗證了一下
Public Sub mysub()
MsgBox ThisWorkbook.Path
End Sub
運行代碼后輸出了我的Excel文件所在的文件夾的路徑。然后再試試
Public Sub mysub()
MsgBox Dir(ThisWorkbook.Path)
End Sub
居然是個空字符串，經過一番思考嘗試，發現加個/就可以輸出文件夾下的第一個文件的文件名了。
比如我的Excel文件路徑為【D:/A/B.xls】，那么ThisWorkbook.Path的值就是【D:/A】，如果后面不加/，就會認為是查找D盤下面叫A的文件，查詢后沒有這個文件，就返回空字符串""了。
接下來試圖輸出所有的文件名，就要用到循環了，在示例里后面就是個循環結構，根據它可以看出VBA循環語句的寫法
Do While 循環條件
Loop
示例里還有一個要划重點的地方
' 若第二次調用 Dir 函數，但不帶任何參數，則函數將返回同一目錄下的下一個 *.ini 文件。
MyFile = Dir
驗證一下
Public Sub mysub()
Dim fileName As String
fileName = Dir(ThisWorkbook.Path & "/")
MsgBox fileName
fileName = Dir
MsgBox fileName
End Sub
所以輸出文件夾下所有文件文件名的代碼就是
Public Sub mysub()
Dim fileName As String
fileName = Dir(ThisWorkbook.Path & "/")
Do While fileName <> ""
MsgBox fileName
fileName = Dir
Loop
End Sub
運行結果和期待的一樣。
獲取數據
知道了怎么獲取文件名，然后就是通過文件名獲取數據了。
第一步還是百度，知道了有個函數叫GetObject，然后查幫助文檔
GetObject函數返回文件中的
ActiveX對象的引用。語法
GetObject([pathname] [, class])
幫助文檔的搜索對大小寫敏感，搜索getObject是查不出GetObject的。
可以看到函數返回的是個對象，於是得弄清楚返回的是什么對象把，又查到了個TypeName函數
TypeName函數返回一個
String，提供有關變量的信息。語法
TypeName(varname)必要的 varname 參數是一個 Variant，它包含用戶定義類型變量之外的任何變量。
測試一下
Public Sub mysub()
Dim filePath As String
Dim fileName As String
filePath = ThisWorkbook.Path & "\"
fileName = Dir(filePath & "*.xls")
Set wb = GetObject(filePath & fileName)
MsgBox TypeName(wb)
End Sub
輸出結果是Workbook，所以打開Excel文檔，返回的是Workbook對象，通過這個對象就可以操作數據了。
通過Range對象可以獲取一個區域的數據，它需要提供區域的起始和結束單元格做為參數，
通過Range對象的Cells屬性，可以獲得單元格，測試
Public Sub mysub()
Dim filePath As String
Dim fileName As String
Dim wb As workbook
filePath = ThisWorkbook.Path & "\"
fileName = Dir(filePath & "*.xls")
Set wb = GetObject(filePath & fileName)
MsgBox wb.Sheets(1).Cells(1, 1).Value
End Sub
輸出了第1行第1列單元格的數據，可以看到單元格索引是從1開始的，而不是一般編程的0。
那么表格那么大，有數據的范圍怎么獲取呢？
Range對象的End方法，效果相當於按住【End】鍵同時按方向鍵，所以它的參數有四種選擇：
xlUp往上xlDown往下xlToLeft往左xlToRight往右
獲取表格中有數據的行數可以使用Cell(1,1).End(xlDown).Row，效果是從第1行第1列開始往下數，到第一個沒有數據的單元格結束，這樣就有個問題，如果中間某一行有空值，行數統計就不對了，還有一個問題，如果只有第1行第1列有數據，則這條語句會返回表格的最大行數，具體原因可以通過按【End】+方向鍵體會。
然后還有一種方法，Cell(65536,1).End(xlUp).Row，效果是從第65536行的第1列往上數，到第一個有數據的單元格結束，這樣比較通用。
經過多次實驗，可以猜測End方法就是往四個方向數，遇到與起始單元格情況不同的單元格就結束。
這里又有個問題，怎么知道數據表支持的最大行和最大列，這個Excel版本不同就不同的，2003版是65536行，2007版及之后是1048576行，這個問題還沒解決。
總之現在是能獲得數據區域了，左上角單元格為Cells(1,1)，右下角單元格為Cells(Cell(65536,列數).End(xlUp).Row，列數)，其實列數也能代碼判斷出來，但是合並是要相同結構的，列數一般是已知且固定不變的，就不用浪費CPU去判斷了。
現在總算能獲得有數據的區域了
Public Sub mysub()
'列數
Dim colNumber As Integer
colNumber = 2
'左上角
Dim startCell As Range
Set startCell = ThisWorkbook.Sheets(1).Cells(1, 1)
'右下角
Dim endCell As Range
Set endCell = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Cells(65536, colNumber).End(xlUp).Row, colNumber)
'將有數據的區域選擇出來
ThisWorkbook.Sheets(1).Range(startCell, endCell).Select
End Sub
運行之后准確的選擇了有數據的區域。
復制數據
復制比較簡單，看到Excel幫助文檔的Range.Copy方法
Range.Copy方法
將單元格區域復制到指定的區域或剪貼板中。
語法
表達式.Copy(Destination)表達式 一個代表
Range對象的變量。
編一小段代碼測試一下
Public Sub mysub()
Dim range1 As range
Dim range2 As range
Set range1 = ThisWorkbook.Sheets(1).range("A1")
Set range2 = ThisWorkbook.Sheets(1).range("B1")
range1.Copy range2
End Sub
運行這段代碼成功的把A1單元格的值復制到了B1單元格中。
編程習慣方法調用的時候參數放括號里了，所以一開始寫成了range1.Copy(range2)，運行時居然報錯了，查了一下雖然沒弄明白，但是似乎是括號會把對象轉換成它的值，相當於range1.Copy range2.Value。
粘貼數據
Range.Copy就已經能把數據復制和粘貼了，現在需要弄清粘貼到哪里，就是粘貼到哪個Range。
需要的是粘貼到目標數據表的數據的最后一行的下一行，數據的最后一行可以用Cells(65536,1).End(xlTop).Row獲取。
完成需求
把上面學到的東西拼起來，就可以實現多個文件的合並了。
首先獲取文件，假設需要合並的文件放在了data文件夾里面，data文件夾里有3個Excel文件：
- A.xls
| index | name |
|---|---|
| 1 | A |
- B.xls
| index | name |
|---|---|
| 1 | B |
- C.xls
| index | name |
|---|---|
| 1 | C |
下面要做的是把這三個文件合並在一起，在與data目錄同級的文件夾下建一個空的合並.xlsm，打開宏代碼編輯頁面，先獲取data目錄下的所有Excel文件
Public Sub mysub()
'聲明文件夾路徑
Dim filePath As String
'聲明文件名稱
Dim fileName As String
'文件夾路徑為當前Excel目錄下的data目錄
filePath = ThisWorkbook.Path & "/data/"
'第一個Excel的文件名用Dir方法獲取，獲取所有.xlsx結尾的文件
fileName = Dir(filePath & "*.xlsx")
'先顯示一下每個文件的名稱，確保上面的代碼能正確工作
Do While fileName <> ""
MsgBox filePath & fileName
'獲取下一個文件的文件名
fileName = Dir
Loop
End Sub
運行后顯示是正確的，下一步是獲取數據
Public Sub mysub()
'聲明文件夾路徑
Dim filePath As String
'聲明文件名稱
Dim fileName As String
'聲明文件對應的工作簿
Dim fileWorkbook As Workbook
'文件夾路徑為當前Excel目錄下的data目錄
filePath = ThisWorkbook.Path & "/data/"
'第一個Excel的文件名用Dir方法獲取，獲取所有.xlsx結尾的文件
fileName = Dir(filePath & "*.xlsx")
'先顯示一下每個文件的名稱，確保上面的代碼能正確工作
Do While fileName <> ""
'當前文件的工作簿
Set fileWorkbook = GetObject(filePath & fileName)
'輸出第一格單元格的值看看
MsgBox fileWorkbook.Sheets(1).range("A1").Value
'獲取下一個文件的文件名
fileName = Dir
Loop
End Sub
成功輸出了每個文件第一個單元格的值。然后就是獲取我們要復制的區域了和粘貼區域，再把數據復制粘貼就可以了。
Public Sub mysub()
'標題占據的行數
Dim titleLineCount As Integer
'表格的列數
Dim colCount As Integer
'目標表格已有數據的行數
Dim dataLineCount As Integer
titleLineCount = 1
colCount = 2
dataLineCount = titleLineCount
'聲明文件夾路徑
Dim filePath As String
'聲明文件名稱
Dim fileName As String
'聲明文件對應的工作簿
Dim fileWorkbook As Workbook
'文件夾路徑為當前Excel目錄下的data目錄
filePath = ThisWorkbook.Path & "/data/"
'第一個Excel的文件名用Dir方法獲取，獲取所有.xlsx結尾的文件
fileName = Dir(filePath & "*.xlsx")
'先顯示一下每個文件的名稱，確保上面的代碼能正確工作
Do While fileName <> ""
'要復制的區域
Dim copyRange As range
'要粘貼的區域
Dim paste As range
'左上角單元格
Dim startCell As range
'右下角
Dim endCell As range
'當前文件的工作簿
Set fileWorkbook = GetObject(filePath & fileName)
Set startCell = fileWorkbook.Sheets(1).Cells(titleLineCount + 1, 1)
Set endCell = fileWorkbook.Sheets(1).Cells(fileWorkbook.Sheets(1).Cells(65536, colCount).End(xlUp).Row, colCount)
Set copyRange = fileWorkbook.Sheets(1).range(startCell, endCell)
Set pasteRange = ThisWorkbook.Sheets(1).range(ThisWorkbook.Sheets(1).Cells(dataLineCount + 1, 1), ThisWorkbook.Sheets(1).Cells(dataLineCount + copyRange.Rows.Count, colCount))
'目標文件的數據行數更新一下
dataLineCount = dataLineCount + copyRange.Rows.Count
'復制並粘貼
copyRange.Copy pasteRange
'關閉當前表格文件
fileWorkbook.Close (False)
'獲取下一個文件的文件名
fileName = Dir
Loop
End Sub
來看看效果
總結
我學習編程，就喜歡動手實現，確實通過這個小需求，也學到了不少東西：
Dir函數用於循環獲取文件名GetObject函數用來獲取文件數據End函數用來獲取表中有數據的行數和列數- VBA的循環語句的寫法
- 更熟悉和習慣了VBA的編程風格