Excel VBA 基礎(03.4) - Excel對象模型之Workbook/Worksheet(一)

之前關注了一些知乎上關於Excel的提問以及本專欄下讀者朋友們的留言，好多實戰中難點歸根到底都涉及到Excel多工作簿的匯總與交互。本期專欄文章將以這個問題作為切入點來講述本期主題Workbook/Worksheet，並且跟大家分享應對此種問題我的解決方式。

例子3.4.1. 試通過添加VLOOKUP公式解決如下數據匯總問題

* 當前路徑下有一個 名為 src 的文件夾，該文件夾包括了所有分公司的月度數據，按公司以及月度分別作為單獨電子表格儲存

* 例如A公司 2018年4月數據存儲的表格名為 A_2018_04, 電子表格文件格式可能為 .xlsx /.xls/.xlsm

* 按月份將分公司數據匯總至一張工作表當中，各分公司分別為該工作表中一列。如 A_2018_04， B_2018_04 兩文件中的數據匯總至工作表 2018_04

* 月份以及公司名稱，公司數量未知

示例文件下載鏈接如下

3.4.1 示例文件?

qiou.eu

先說業務邏輯，

1. 從最本源問題出發，首先考慮如何處理單個文件。本例要求將各文件中的數據匯總，即，將單個文件中的內容輸出到指定的工作表中，那麼處理該問題的函數至少包括兩個參數，即 匯總工作簿對象(Workbook) 以及 分公司工作簿對象
2. 然後考慮如何獲取 兩參數，匯總工作表對簿已知，分公司工作簿對象 可以通過遍歷文件夾打開相應文件獲取。

根據以上思路，先 確定 兩函數，兩函數功能相對獨立，分別封裝，方便復用。

處理單個文件，結合此例 wb為分公司工作簿， this為匯總工作簿Sub interface_processWorkbook(ByRef wb As Workbook, ByRef this As Workbook) 遍歷文件夾 並調用 處理單個文件的介面函數interface_processWorkbook path 為文件相對本工作表的相對路徑 readOnly 是否以只讀模式操作目標路徑中的工作簿Public Sub processWorkbooksInthePath(Optional ByVal path As String = "src", Optional ByVal readOnly As Boolean = True)

以下代碼片段源於我的Github項目，完全出自實際項目。

loop through the file system define the interface of sub interface_processWorkbook(byref wb as workbook, byref this as workbook) 處理指定路徑下的 Excel文件Public Sub processWorkbooksInthePath(Optional ByVal path As String = "src", Optional ByVal readOnly As Boolean = True) 異常處理 以後介紹 On Error GoTo handler 關閉屏幕刷新 不推薦關自動計算，特別 是在數據處理的場景下關自動計算可能出現異常情況 Application.ScreenUpdating = False 定義FSO 獲取文件集合 Dim fso As Object Set fso = CreateObject("scripting.filesystemobject") 目標絕對路徑 Dim targPath As String targPath = Trim(ActiveWorkbook.path & "" & path) 絕對路徑不能以反斜杠結尾，去掉最末反斜杠 If Right(targPath, 1) = "" Then targPath = Left(targPath, Len(targPath) - 1) End If 定義正則表達示 判斷文件後綴是否合規 以後介紹 Dim re As Object Set re = CreateObject("vbscript.regexp") 當前工作簿 即匯總信息工作簿 涉及多工作簿時一定要指明所處理的工作簿 對象模型 的結構 以後概論 請參考之前文章 Dim this As Workbook Set this = ThisWorkbook 單獨文件對應的工作簿 Dim that As Workbook 指定正則 With re .Pattern = ".xls(m|x)?$" End With 遍歷目標文件夾 循環變數，即各文件 Dim i As Object 目標文件夾 Dim p As Object 文件名 Dim fName As String 獲取文件夾對象 Set p = fso.getfolder(targPath) 通過文件夾 取得其下所有文件 For Each i In p.Files fName = i.name 如果文件名稱非臨時文件， 且為Excel文件 並且非本文件 則 打開該文件 If Left(fName, 1) <> "~" And re.test(fName) And fName <> this.name Then Application.Workbooks.Open targPath & "" & fName, 0, readOnly Set that = ActiveWorkbook 傳遞目標工作表 以及 當前工作表對象給 具體處理事務的的函數 Call interface_processWorkbook(that, this) 關閉目標工作表 並決定是否保存 that.Close Not readOnly End If Next i 開啟 屏幕刷新 如有異常則拋出異常handler: Application.ScreenUpdating = True If Err.Number <> 0 Then MsgBox "error" End IfEnd Sub 處理表格 函數待補充Sub interface_processWorkbook(ByRef wb As Workbook, ByRef this As Workbook) Debug.Print wb.Worksheets(1).nameEnd Sub

中間涉及到FSO以及正則表達式的運用，在此僅需要結合注釋初步了解，以後會詳細介紹。

此處FSO的作用可以簡單理解為獲取指定路徑下文件的集合，通過Foreach進行遍歷

正則表達式用來判斷文件後綴是否為Excel相關的合法格式。

這裡想重點說一說 面向介面(Interface) 這一編程思路 以及 Workbook/Worksheet 對象的運用。

先來說一說介面。正如上例當中，遍歷文件夾的操作與處理工作表的操作是完全獨立的兩個操作，兩個 Sub之間僅僅通過參數傳遞進行聯繫 interface_processWorkbook 的具體內部實現在所不問，processWorkbooksInthePath 只需要將指定參數傳給處理函數即可。依據具體業務需求的不同，只需要對interface_processWorkbook進行相應修改。即依賴應用場景，專註於單一文件的處理，由此對於多表聯動的類型化問題給出一個可以復用的高效的解決方案。

在具體實現 處理單一文件的函數之前，有必要再提一下Excel的對象模型的特點。正如之前文章中提到，整個Excel體系就是一棵樹，我們如果得到工作簿對象，也就意味著我們可以順著這棵樹的主幹找到枝葉，即我們所要處理的工作表以及單元格。

接下來，我們補充 Sub interface_processWorkbook

Private Sub interface_processWorkbook(ByRef wb As Workbook, ByRef this As Workbook) 解析文件名 提取 公司名稱 以及 所在月度 A_2018_04.xlsx 分別返回 A 以及 2018_04 Dim nameArr Dim nameMonth As String Dim nameEntity As String 解析文件名函數返回 數組第一個元素 為公司名 第二個為月度 nameArr = parseFileName(wb.name) nameEntity = nameArr(0) nameMonth = nameArr(1) 如果不存在目標工作表，以月度為名稱，在匯總工作簿中添加相應工作表, 樣式從overview工作表中複製 addShtWithName this, nameMonth, "overview" 取得目標工作表對象 如 2018_04 Dim targSht As Worksheet Set targSht = this.Worksheets(nameMonth) 取得數據來源工作表對象 從單一工作簿對象中取得 默認為第一張表 Dim srcSht As Worksheet Set srcSht = wb.Worksheets(1) 取得目標工作表中最末一列的列號 每列對應一個公司 在最左邊增加新的一列 準備寫入公式 Dim targCol As Long targCol = targSht.Cells(1, targSht.Columns.Count).End(xlToLeft).Column + 1 該列第一行中填入公司名稱 如A targSht.Cells(1, targCol).Value = nameEntity 取得目標工作表總行數 Dim y As Long y = targSht.Cells(targSht.Rows.Count, 1).End(xlUp).Row 從第2行開始 遍歷增加相應公式 公式內容不贅述 此處也可以 Fill Dim i For i = 2 To y targSht.Cells(i, targCol).Formula = "=IFERROR(VLOOKUP(" & targSht.Cells(i, 1).Address(0, 0) & ",[" & wb.name & "]" & srcSht.name & "!" & srcSht.UsedRange.Columns.Address & "," & srcSht.UsedRange.Columns.Count & ", 0)," & """"")" Next i 釋放內存 Set targSht = Nothing Set srcSht = Nothing End Sub 如果指定 工作表不存在 則新增Private Function addShtWithName(ByRef wb As Workbook, shtName As String, tmplIdx As Variant) On Error Resume Next 判斷是否存在工作表， 介紹異常處理再詳細說明 If Not shtExists(wb, shtName) Then Application.ScreenUpdating = False With wb 複製模版 工作表 增加到最後位置 並改名 .Worksheets(tmplIdx).Copy , .Worksheets(.Worksheets.Count) .Worksheets(.Worksheets.Count).name = shtName End With Application.ScreenUpdating = True End IfEnd Function 判斷是否存在工作表 介紹異常處理再詳細說明Private Function shtExists(ByRef wb As Workbook, shtName As String) As Boolean On Error GoTo handler shtExists = Not wb.Worksheets(shtName) Is Nothinghandler: If Err.Number <> 0 Then shtExists = False End IfEnd Function 解析文件名 Private Function parseFileName(name As String) On Error GoTo handler Dim nameArr Dim nameMonth As String Dim nameEntity As String 去掉 文件後綴 Dim reg As Object Set reg = CreateObject("vbscript.regexp") reg.Pattern = ".xls[^.]*$" 以 下橫杆 分成兩部分， 第一部分為公司名，第二部分去後綴為月度名 nameArr = Split(name, "_", 2) nameEntity = nameArr(0) nameMonth = reg.Replace(nameArr(1), "") parseFileName = Array(nameEntity, nameMonth)handler: Set reg = Nothing If Err.Number <> 0 Then MsgBox "ill-formed file name: " & name End IfEnd Function

這個小案例綜合了之前的對象模型的知識，請務必消化。

Worksheet對象請重點掌握 name 屬性, add 和 copy 方法。

實戰中的案例無非就是這個基礎情況的變化，無非就在處理過程中多增加一些判斷分支。總體思路都是一樣的。

有任何問題請在下方留言。

本專欄所有文章著作權歸屬本人。未經本人書面許可，除知乎日報外，任何人不得轉載。