完善VBA巨集以增加【張數筆數統計】功能

全面指南：如何在VBA巨集中添加並優化張數筆數統計

關鍵要點

功能擴展：成功在現有VBA巨集中添加了【張數筆數統計】部分，實現對出入金分頁的全面統計。
精確計算：根據具體統計規則，準確計算總張數、多筆張數及總筆數，提升數據分析的精度。
自動化報告：統計結果自動保存至文本檔，並即時彈出顯示，極大提高工作效率。

更新後的VBA巨集

以下是根據您的需求，更新後的完整VBA巨集程式碼。此版本已新增【張數筆數統計】功能，並根據指定的統計規則進行計算：

Sub 出入金統計()

    Dim inputDate As String
    Dim targetDate As String
    Dim yearPrefix As String
    Dim filePath As String
    Dim statPath As String
    Dim wb As Workbook
    Dim ws As Variant ' 修改為 Variant 類型
    Dim summary As String
    Dim trusteeName As Variant
    Dim trusteeStats As Variant
    Dim i As Long
    Dim huanNanStats As String
    Dim outMoney As String
    Dim inMoney As String
    Dim fileNum As Integer
    Dim yuanDaStats As String

    ' 統計額外需求的變數
    Dim totalSheets As Long
    Dim multiSheets As Long
    Dim totalEntries As Long

    ' 預設日期為今天
    targetDate = Format(Date, "yyyymmdd")

    ' 輸入日期
    inputDate = InputBox("請輸入要統計的日期 (四碼或八碼數字):", "日期輸入", Format(Date, "mmdd"))

    If inputDate = "" Then
        MsgBox "未輸入日期，將以今天日期作為預設值: " & targetDate, vbInformation
    Else
        If Len(inputDate) = 4 Then
            yearPrefix = Year(Date)
            targetDate = yearPrefix & inputDate
        ElseIf Len(inputDate) = 8 Then
            targetDate = inputDate
        Else
            MsgBox "輸入日期格式錯誤！請輸入四碼 (MMDD) 或八碼 (YYYYMMDD)。", vbCritical
            Exit Sub
        End If
    End If

    ' 建立檔案路徑
    filePath = "G:\26_Investment Insurance Policy\1_Custody\6_基金下單表格\Fund 執行單 & Instruction\執行單\" & targetDate & "\Asia\" & targetDate & "內部執行單試算表-Asia-send.xlsm"
    statPath = "G:\68_Vincent\試作工作表格紀錄\基金回盤上傳\出入金統計\" & targetDate & "_出入金統計.txt"

    ' 開啟檔案 (唯讀模式)
    On Error Resume Next
    Set wb = Workbooks.Open(filePath, ReadOnly:=True)
    If wb Is Nothing Then
        MsgBox "無法開啟檔案，請確認路徑是否正確: " & filePath, vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    ' 初始化統計資料
    totalSheets = 0
    multiSheets = 0
    totalEntries = 0
    trusteeName = Array("復華投信", "富蘭克林華美投信", "凱基投信", "兆豐投信", "合庫投信", "霸菱投顧", "台新投信", "瀚亞投信", "統一投顧", "華南永昌投信", "中國信託投信", "聯博投信", "元大投信")
    trusteeStats = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

    ' 統計分頁
    For Each ws In wb.Sheets
        If ws.Name Like "*出金" Or ws.Name Like "*入金" Then
            Dim hasD8 As Boolean, hasE8 As Boolean
            hasD8 = False
            hasE8 = False

            If IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0 Then
                hasD8 = True
                totalEntries = totalEntries + 1 ' D8計入一筆
            End If

            If IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0 Then
                hasE8 = True
                totalEntries = totalEntries + 1 ' E8計入一筆
            End If

            ' 總張數：D8 或 E8 任一有值
            If hasD8 Or hasE8 Then
                totalSheets = totalSheets + 1
            End If

            ' 多筆張數：D8 和 E8 都有值
            If hasD8 And hasE8 Then
                multiSheets = multiSheets + 1
            End If

            ' 受託人統計
            For i = LBound(trusteeName) To UBound(trusteeName)
                If ws.Range("A3").Value Like "*受託人：" & trusteeName(i) & "*" Then
                    trusteeStats(i) = trusteeStats(i) + 1
                End If
            Next i
        End If
    Next ws

    ' 組合摘要
    summary = "【出入金統計】" & vbCrLf
    For i = LBound(trusteeName) To UBound(trusteeName)
        summary = summary & trusteeName(i) & "： " & trusteeStats(i) & " 張" & vbCrLf
    Next i

    ' 添加【張數筆數統計】
    summary = summary & vbCrLf & "【張數筆數統計】" & vbCrLf
    summary = summary & "總張數：" & totalSheets & " 張" & vbCrLf
    summary = summary & "多筆張數：" & multiSheets & " 張" & vbCrLf
    summary = summary & "總筆數：" & totalEntries & " 筆" & vbCrLf

    ' 儲存到記事本
    fileNum = FreeFile

    Open statPath For Output As #fileNum
    Print #fileNum, summary
    Close #fileNum

    ' 打開記事本顯示統計結果
    Shell "notepad.exe " & statPath, vbNormalFocus

    MsgBox "出入金統計已完成！結果已保存到: " & statPath, vbInformation
End Sub

修改說明

宣告統計變數：在變數宣告區域新增了 totalSheets、multiSheets 和 totalEntries，用於分別計算總張數、多筆張數及總筆數。
統計邏輯的調整：
- 總張數：檢查每個工作表名稱是否以「出金」或「入金」結尾，且D8或E8單元格有不為0或空白的值，若符合則計入總張數。
- 多筆張數：在上述基礎上，進一步檢查D8和E8是否同時有不為0或空白的值，若符合則計入多筆張數。
- 總筆數：分別累計D8和E8中不為0或空白的數量，若同一分頁中兩者皆有值，則總筆數增加2。
結果組合與輸出：將統計結果組合至 summary 字串中，並保存至指定的文本檔路徑，最後自動打開記事本顯示結果。

統計規則詳解

統計項目	計算規則
總張數	計算所有結尾為「出金」或「入金」的分頁，且D8或E8單元格有不為0或不為空白的值，才將該分頁計入總張數。
多筆張數	計算所有結尾為「出金」或「入金」的分頁，且D8和E8單元格皆有不為0或不為空白的值，才將該分頁計入多筆張數。
總筆數	累計所有分頁中D8與E8單元格有不為0或不為空白的值，若同一分頁中D8與E8皆有值，則總筆數增加2筆。

使用說明

啟動宏：打開包含VBA巨集的Excel檔案，按下 Alt + F8，選擇 出入金統計，然後點擊「執行」。
輸入日期：系統將彈出輸入框，要求您輸入統計的日期。請按照「MMDD」或「YYYYMMDD」格式輸入。例如，今天是2025年1月22日，預設輸入值將顯示為「0122」。
查看結果：宏執行完成後，統計結果將自動保存至指定的文本檔路徑，並即時在記事本中打開顯示。您也會收到一個消息框提示統計完成。

常見問題解答

1. 為什麼宏無法打開指定的Excel檔案？

確保檔案路徑 filePath 是正確的，並且該路徑下的Excel檔案存在。此外，檢查您的系統是否有權限訪問該路徑。

2. 如何修改統計的日期格式？

在宏中，您可以調整 Format(Date, "yyyymmdd") 的格式參數，以符合您所需的日期顯示方式。例如，改為 "yyyy-mm-dd" 可顯示為「2025-01-22」。

3. 統計結果為何不顯示？

首先確認宏是否順利執行完畢。若有錯誤提示，請根據錯誤信息進行調整。此外，確保統計結果的文本檔路徑正確，並且該路徑具有寫入權限。

優化建議

錯誤處理強化：目前宏僅處理了無法打開檔案的錯誤，建議增加更多錯誤處理機制，以應對例如單元格數據格式錯誤等情況。
動態調整受託人列表：將受託人名稱存儲在外部檔案或工作表中，方便日後更新，而不需直接修改VBA程式碼。
多語言支持：根據使用者需求，增加多語言界面或註解，提升可用性。

完整VBA巨集程式碼

下方提供了完整的VBA巨集程式碼，已包含所有新增及修改的部分。您可以直接將此程式碼複製至VBA編輯器中使用：

Sub 出入金統計()

    Dim inputDate As String
    Dim targetDate As String
    Dim yearPrefix As String
    Dim filePath As String
    Dim statPath As String
    Dim wb As Workbook
    Dim ws As Variant ' 修改為 Variant 類型
    Dim summary As String
    Dim trusteeName As Variant
    Dim trusteeStats As Variant
    Dim i As Long
    Dim huanNanStats As String
    Dim outMoney As String
    Dim inMoney As String
    Dim fileNum As Integer
    Dim yuanDaStats As String

    ' 統計額外需求的變數
    Dim totalSheets As Long
    Dim multiSheets As Long
    Dim totalEntries As Long

    ' 預設日期為今天
    targetDate = Format(Date, "yyyymmdd")

    ' 輸入日期
    inputDate = InputBox("請輸入要統計的日期 (四碼或八碼數字):", "日期輸入", Format(Date, "mmdd"))

    If inputDate = "" Then
        MsgBox "未輸入日期，將以今天日期作為預設值: " & targetDate, vbInformation
    Else
        If Len(inputDate) = 4 Then
            yearPrefix = Year(Date)
            targetDate = yearPrefix & inputDate
        ElseIf Len(inputDate) = 8 Then
            targetDate = inputDate
        Else
            MsgBox "輸入日期格式錯誤！請輸入四碼 (MMDD) 或八碼 (YYYYMMDD)。", vbCritical
            Exit Sub
        End If
    End If

    ' 建立檔案路徑
    filePath = "G:\26_Investment Insurance Policy\1_Custody\6_基金下單表格\Fund 執行單 & Instruction\執行單\" & targetDate & "\Asia\" & targetDate & "內部執行單試算表-Asia-send.xlsm"
    statPath = "G:\68_Vincent\試作工作表格紀錄\基金回盤上傳\出入金統計\" & targetDate & "_出入金統計.txt"

    ' 開啟檔案 (唯讀模式)
    On Error Resume Next
    Set wb = Workbooks.Open(filePath, ReadOnly:=True)
    If wb Is Nothing Then
        MsgBox "無法開啟檔案，請確認路徑是否正確: " & filePath, vbCritical
        Exit Sub
    End If
    On Error GoTo 0

    ' 初始化統計資料
    totalSheets = 0
    multiSheets = 0
    totalEntries = 0
    trusteeName = Array("復華投信", "富蘭克林華美投信", "凱基投信", "兆豐投信", "合庫投信", "霸菱投顧", "台新投信", "瀚亞投信", "統一投顧", "華南永昌投信", "中國信託投信", "聯博投信", "元大投信")
    trusteeStats = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)

    ' 統計分頁
    For Each ws In wb.Sheets
        If ws.Name Like "*出金" Or ws.Name Like "*入金" Then
            Dim hasD8 As Boolean, hasE8 As Boolean
            hasD8 = False
            hasE8 = False

            If IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0 Then
                hasD8 = True
                totalEntries = totalEntries + 1 ' D8計入一筆
            End If

            If IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0 Then
                hasE8 = True
                totalEntries = totalEntries + 1 ' E8計入一筆
            End If

            ' 總張數：D8 或 E8 任一有值
            If hasD8 Or hasE8 Then
                totalSheets = totalSheets + 1
            End If

            ' 多筆張數：D8 和 E8 都有值
            If hasD8 And hasE8 Then
                multiSheets = multiSheets + 1
            End If

            ' 受託人統計
            For i = LBound(trusteeName) To UBound(trusteeName)
                If ws.Range("A3").Value Like "*受託人：" & trusteeName(i) & "*" Then
                    trusteeStats(i) = trusteeStats(i) + 1
                End If
            Next i
        End If
    Next ws

    ' 組合摘要
    summary = "【出入金統計】" & vbCrLf
    For i = LBound(trusteeName) To UBound(trusteeName)
        summary = summary & trusteeName(i) & "： " & trusteeStats(i) & " 張" & vbCrLf
    Next i

    ' 添加【張數筆數統計】
    summary = summary & vbCrLf & "【張數筆數統計】" & vbCrLf
    summary = summary & "總張數：" & totalSheets & " 張" & vbCrLf
    summary = summary & "多筆張數：" & multiSheets & " 張" & vbCrLf
    summary = summary & "總筆數：" & totalEntries & " 筆" & vbCrLf

    ' 儲存到記事本
    fileNum = FreeFile

    Open statPath For Output As #fileNum
    Print #fileNum, summary
    Close #fileNum

    ' 打開記事本顯示統計結果
    Shell "notepad.exe " & statPath, vbNormalFocus

    MsgBox "出入金統計已完成！結果已保存到: " & statPath, vbInformation
End Sub

詳細功能解析

1. 變數宣告與初始化

在VBA巨集中，首先宣告了多個變數以儲存不同類型的數據，包括日期、檔案路徑、受託人名稱及統計數據等。特別新增的變數 totalSheets、multiSheets 和 totalEntries 用於分別記錄總張數、多筆張數及總筆數。

2. 日期輸入與處理

宏會彈出一個輸入框，要求用戶輸入統計的日期。用戶可以輸入四位數（MMDD）或八位數（YYYYMMDD）格式的日期。若未輸入，則默認使用當天日期。根據輸入的長度，宏會自動補全年份或直接使用完整日期。

3. 檔案路徑設定與打開

根據目標日期，宏會構建出入金統計所需的Excel檔案路徑 filePath 及統計結果文本檔路徑 statPath。隨後，宏會嘗試以唯讀模式打開指定的Excel檔案，若無法成功開啟，則顯示錯誤訊息並終止執行。

4. 統計邏輯實現

宏遍歷每一個工作表，檢查分頁名稱是否以「出金」或「入金」結尾。對於符合條件的分頁，進一步檢查D8和E8單元格是否有不為0或不為空白的數值，以計算總張數、多筆張數及總筆數。同時，根據受託人名稱，統計各受託人的出入金張數。

5. 結果組合與輸出

將所有統計結果組合至 summary 字串中，格式包括【出入金統計】和新增的【張數筆數統計】部分。最終，宏會將結果保存至指定的文本檔，並自動在記事本中顯示，讓用戶可以即時查看統計結果。

統計規則說明

統計項目	計算規則
總張數	計算所有結尾為「出金」或「入金」的分頁，且D8或E8單元格有不為0或不為空白的值，才將該分頁計入總張數。
多筆張數	計算所有結尾為「出金」或「入金」的分頁，且D8和E8單元格皆有不為0或不為空白的值，才將該分頁計入多筆張數。
總筆數	累計所有分頁中D8與E8單元格有不為0或不為空白的值，若同一分頁中D8與E8皆有值，則總筆數增加2筆。

實作步驟

複製現有VBA巨集：在Excel中打開VBA編輯器（按下 Alt + F11），找到並複製現有的 出入金統計 巨集。
新增統計變數：在變數宣告區域，加入 totalSheets、multiSheets 和 totalEntries 變數，初始值設為0。
調整統計循環：在遍歷每個工作表時，根據分頁名稱及D8、E8單元格的值進行判斷和計數。
組合並輸出結果：將統計結果整合至 summary 字串中，並保存至指定的文本檔路徑，最後自動打開記事本顯示結果。
測試與驗證：運行宏，輸入相應日期，確保統計結果符合預期，並確認文本檔正確生成。

最佳實踐與優化

數據驗證：在運行宏前，確保所有受託人名稱和分頁名稱都已正確填寫，避免因命名不一致導致統計錯誤。
路徑管理：考慮將檔案路徑設為可配置變數，或存儲在工作表中，方便日後維護和更新。
錯誤處理增強：除了檢查檔案打開錯誤，還應添加對數據格式錯誤、單元格缺失等情況的處理，增強宏的穩定性。
性能優化：對於大規模數據集，考慮使用更高效的數據處理方法，如範圍批量讀取，減少VBA的循環次數。

結論

通過本次VBA巨集的更新，您已成功實現了【張數筆數統計】功能，能夠自動計算並統計出入金分頁的總張數、多筆張數及總筆數。此舉不僅提升了數據處理的效率，也提高了統計結果的準確性。未來，根據業務需求的變化，您可以進一步擴展和優化此宏，以滿足更複雜的數據分析需求。

參考資料

stackoverflow.com

Counting pages in each worksheet - excel - Stack Overflow

mrexcel.com

VBA Page Count | MrExcel Message Board

learn.microsoft.com

Pages.Add method (Publisher) - Microsoft Learn

Last updated January 22, 2025