我們有時候需要將在同一個文件夾下的多個工作薄的數據到同一個工作表當中，首先我們需要確認的是這些數據的格式是否具有一致性，如果所有的數據格式都是一樣的，那么這個問題就非常好處理了。
的方法其實非常多，SQL、Power Qurey法,方法。相比前兩種方法，VBA有更好的靈活性。每個的數據處理方法都不一樣，做法都不一樣。因此我們今天和大家分享的是通過VBA代碼來解決這個問題。但是對于我們大部分來說，這個是一件非常痛苦的事情。要么自己的去寫代碼，要么到網上找代碼，然后修改。
舉一個例子:
Test文件夾下有3個工作簿，每個工作薄的第一個表的數據格式都是一致的。
目前我們的需求是將Test文件夾下的所有工作薄的sheets1的數據匯總到總表中。
您只需要將以下代碼復制到Excel的VBE窗口的模塊中，然后執行程序即可。
Sub?wktest()
????Dim?Trow&,?k&,?arr,?brr,?i&,?j&,?book&,?a&
????Dim?p$,?f$,?Rng?As?Range
????With?Application.FileDialog(msoFileDialogFolderPicker)
????'取得用戶選擇的文件夾路徑
????????.AllowMultiSelect?=?False
????????If?.Show?Then?p?=?.SelectedItems(1)?Else?Exit?Sub
????End?With
????If?Right(p,?1)?<>?"\"?Then?p?=?p?&?"\"
????'
????Trow?=?Val(InputBox("請輸入標題的行數",?"提醒"))
????If?Trow?<?0?Then?MsgBox?"標題行數不能為負數。",?64,?"警告":?Exit?Sub
????Application.ScreenUpdating?=?False?'關閉屏幕更新
????Cells.ClearContents?'清空當前表數據
????Cells.NumberFormat?=?"@"?'設置單元格格式為文本
????ReDim?brr(1?To?200000,?1?To?1)
????'定義裝匯總結果的數組brr，最大行數為20萬行
????f?=?Dir(p?&?"*.xls*")
????'開始遍歷指定文件夾路徑下的每個工作簿
????Do?While?f?<>?""
????????If?f?<>?ThisWorkbook.Name?Then?'避免同名文件重復打開出錯
????????????With?GetObject(p?&?f)
????????????'以\'只讀\'形式讀取文件時，使用getobject方法會比workbooks.open稍快
????????????????Set?Rng?=?.Sheets(1).UsedRange
????????????????If?IsEmpty(Rng)?=?False?Then?'如果工作表非空
????????????????????book?=?book?+?1?'標記一下是否首個Sheet,如果首個sheet，BOOK=1
????????????????????a?=?IIf(book?=?1,?1,?Trow?+?1)?'遍歷讀取arr數組時是否扣掉標題行
????????????????????arr?=?Rng.Value?'數據區域讀入數組arr
????????????????????If?UBound(arr,?2)?>?UBound(brr,?2)?Then
????????????????????'動態調整結果數組brr的最大列數，避免明細表列數不一的情況。
????????????????????????ReDim?Preserve?brr(1?To?200000,?1?To?UBound(arr,?2))
????????????????????End?If
????????????????????For?i?=?a?To?UBound(arr)?'遍歷行
????????????????????????k?=?k?+?1?'累加記錄條數
????????????????????????For?j?=?1?To?UBound(brr,?2)?'遍歷列
????????????????????????????brr(k,?j)?=?arr(i,?j)
????????????????????????Next
????????????????????Next
????????????????End?If
????????????????.Close?False?'關閉工作簿，不保存。
????????????End?With
????????End?If
????????f?=?Dir?'下一個工作簿
????Loop
????If?k?>?0?Then
????????[a1].Resize(k,?UBound(brr,?2))?=?brr
????????MsgBox?"匯總完成。"
????End?If
????Application.ScreenUpdating?=?True?'恢復屏幕更新
End?Sub
