[Office] WPS Excel通過新增巨集實現多張表格合併

在我們使用Excel時，通常會遇到讓各個地區、各個學院或下屬單位收集資料的情況，有時還會每月、每週，甚至是每日排程資料，而當我們得到了這些Excel檔案表格之後，很多同志會進行人工手動彙總，這大大降低了辦公的效率。本文主要介紹WPS Excel巨集，講述兩種自動彙總表格資料的方法，通過VB程式碼實現。

一、合併當前資料夾下所有檔案表格

假設存在如下貴州省九個市州的資料，如下圖所示：

開啟每個表格的格式都一樣，安順市顯示如下圖所示。注意，如果是向下屬單位收集資料，通常需要固定好格式，方便彙總生成透檢視形，形成最終的報告。

第一步 建立一個新的xls檔案，比如“彙總.xls”。

第二步 在“開發工具”中選擇“VB編輯器”，如下圖所示。

第三步 在彈出的Microsoft Visual Basic介面中，選擇“Project”中的“Sheet1”。

輸入如下程式碼並點選執行按鈕。

Sub 合併當前目錄下所有工作簿的全部工作表()
Dim MyPath, MyName, AWbName
Dim Wb As workbook, WbN As String
Dim G As Long
Dim Num As Long
Dim BOX As String
Application.ScreenUpdating = False
MyPath = ActiveWorkbook.Path
MyName = Dir(MyPath & "\" & "*.xls")
AWbName = ActiveWorkbook.Name
Num = 0
Do While MyName <> ""
If MyName <> AWbName Then
Set Wb = Workbooks.Open(MyPath & "\" & MyName)
Num = Num + 1
With Workbooks(1).ActiveSheet
.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)
For G = 1 To Sheets.Count
Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)
Next
WbN = WbN & Chr(13) & Wb.Name
Wb.Close False
End With
End If
MyName = Dir
Loop
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "共合併了" & Num & "個工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"
End Sub

第四步 彙總資料如下圖所示，同時彙總完成之時會提示對話方塊。

同時刪除多餘的表頭，然後簡單修訂如下圖所示：

注意，在彙總過程中如果出現最後一行為備註事宜，建議刪除只保留統計的資料；同時如果其他Sheet有數值，建議也刪除，否則它也會被複制至彙總表。

第五步 選中所有資料，然後在“資料”欄中點選“資料透視表”。

同時，可以彙總各式各樣的資料，如下圖所示：

二、合併當前檔案各個子Sheet資料

下面講解第二種方法，對當前Excel檔案中的各個Sheet進行彙總，步驟和上述方法一樣，重要的是這段VB巨集程式碼。假設存在黔東南州、安順市、畢節市，如下圖所示：

程式碼如下：

Sub 合併當前工作簿下的所有市級分表工作表()
Application.ScreenUpdating = False
For j = 4 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name
Then
X = Range("A65536").End(xlUp).Row + 1
Sheets(j).UsedRange.Copy Cells(X, 1)
End If
Next
Range("B1").Select
Application.ScreenUpdating = True
MsgBox "當前工作簿下的全部市級分表工作表已經合併完畢！", vbInformation, "提示"
End Sub

最後希望文章對您有所幫助，如果存在不足之處，請海涵~
(By:Eastmount 2017-03-06 下午3點  http://blog.csdn.net/eastmount/ )