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

Eastmount發表於2018-03-06

在我們使用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/ )




相關文章