Excel VBA 出入金統計巨集說明

如何新增【保銀統計】到您的VBA巨集中，全面提升數據分析效率

主要要點

• 擴展功能：新增【保銀統計】部分，提升統計數據的全面性與準確性。
• 代碼整合：優化現有VBA巨集，無縫整合新的統計需求。
• 自動化處理：透過VBA自動化篩選與計算，提高工作效率。

新增【保銀統計】的步驟詳解

1. 新增所需變數

首先，在VBA巨集中定義用於計算各保銀統計的變數。這些變數將用於記錄符合條件的分頁數量。

' 定義【保銀統計】變數
Dim fuhuaCount As Long
Dim hanyahCount As Long
Dim sinopacCount As Long

' 初始化計數
fuhuaCount = 0
hanyahCount = 0
sinopacCount = 0
    

2. 插入統計邏輯

在巨集中的分頁遍歷循環內，插入條件判斷以篩選符合【保銀統計】的分頁，並相應增加計數器。

' 遍歷所有分頁以計算【保銀統計】條件
For Each ws In wb.Sheets
    ' 檢查復華條件
    If ws.Range("A3").Value = "受託人：復華投信" And ws.Range("C3").Value = "保管銀行：台新銀行" Then
        If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
           (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
            fuhuaCount = fuhuaCount + 1
        End If
    End If

    ' 檢查瀚亞條件
    If ws.Range("A3").Value = "受託人：瀚亞投信" And ws.Range("C3").Value = "保管銀行：台新銀行" Then
        If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
           (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
            hanyahCount = hanyahCount + 1
        End If
    End If

    ' 檢查中信條件
    If ws.Range("A3").Value = "受託人：中國信託投信" And ws.Range("C3").Value = "保管銀行：華南銀行" Then
        If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
           (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
            sinopacCount = sinopacCount + 1
        End If
    End If
Next ws
    

3. 更新輸出結果

在巨集的結果輸出部分，新增【保銀統計】的顯示格式，確保統計結果以指定格式呈現。

' 在結果輸出中添加【保銀統計】
summary = summary & vbCrLf & "【保銀統計】" & vbCrLf
summary = summary & "復華(台新保銀)： " & fuhuaCount & " 張" & vbCrLf
summary = summary & "瀚亞(台新保銀)： " & hanyahCount & " 張" & vbCrLf
summary = summary & "中信(華南保銀)： " & sinopacCount & " 張" & vbCrLf
    

完整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 multiEntrySheets As Long
    Dim totalEntries As Long
    
    ' 【保銀統計】變數
    Dim fuhuaCount As Long
    Dim hanyahCount As Long
    Dim sinopacCount As Long
    
    ' 初始化計數
    fuhuaCount = 0
    hanyahCount = 0
    sinopacCount = 0
    
    ' 預設日期為今天
    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
    
    ' 初始化統計資料
    trusteeName = Array("復華投信", "富蘭克林華美投信", "凱基投信", "兆豐投信", "合庫投信", "霸菱投顧", "台新投信", "瀚亞投信", "統一投顧", "華南永昌投信", "中國信託投信", "聯博投信", "元大投信")
    trusteeStats = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
    
    ' 初始化華南(元大保銀)統計資料
    huanNanStats = "【華南(元大保銀)出入金紀錄】" & vbCrLf & "出金：" & vbCrLf
    outMoney = ""
    inMoney = "入金：" & vbCrLf
    
    ' 初始化張數筆數統計
    totalSheets = 0
    multiEntrySheets = 0
    totalEntries = 0
    
    ' 統計分頁
    For Each ws In wb.Sheets
        For i = LBound(trusteeName) To UBound(trusteeName)
            If InStr(ws.Name, "入金") > 0 Or InStr(ws.Name, "出金") > 0 Then
                If ws.Range("A3").Value Like "*受託人：" & trusteeName(i) & "*" Then
                    If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
                       (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
                        trusteeStats(i) = trusteeStats(i) + 1
                        totalSheets = totalSheets + 1
                        If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) And _
                           (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
                            multiEntrySheets = multiEntrySheets + 1
                        End If
                        If IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0 Then
                            totalEntries = totalEntries + 1
                        End If
                        If IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0 Then
                            totalEntries = totalEntries + 1
                        End If
                    End If

                    ' 統計華南(元大保銀)出入金紀錄
                    If ws.Range("A3").Value Like "*受託人：華南永昌投信*" And ws.Range("C3").Value Like "*保管銀行：元大銀行*" Then
                        If ws.Name Like "*出金*" Then
                            If IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0 Then
                                outMoney = outMoney & Format(ws.Range("D8").Value, "#,##0.00") & " 單位" & vbCrLf
                            End If
                            If IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0 Then
                                outMoney = outMoney & Format(ws.Range("E8").Value, "#,##0.00") & " 單位" & vbCrLf
                            End If
                        ElseIf ws.Name Like "*入金*" Then
                            If IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0 Then
                                inMoney = inMoney & Format(ws.Range("E8").Value, "#,##0.00") & " 元" & vbCrLf
                            End If
                        End If
                    End If
                End If
            End If
        Next i

        ' 【保銀統計】部分
        ' 檢查復華條件
        If ws.Range("A3").Value = "受託人：復華投信" And ws.Range("C3").Value = "保管銀行：台新銀行" Then
            If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
               (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
                fuhuaCount = fuhuaCount + 1
            End If
        End If

        ' 檢查瀚亞條件
        If ws.Range("A3").Value = "受託人：瀚亞投信" And ws.Range("C3").Value = "保管銀行：台新銀行" Then
            If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
               (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
                hanyahCount = hanyahCount + 1
            End If
        End If

        ' 檢查中信條件
        If ws.Range("A3").Value = "受託人：中國信託投信" And ws.Range("C3").Value = "保管銀行：華南銀行" Then
            If (IsNumeric(ws.Range("D8").Value) And ws.Range("D8").Value <> 0) Or _
               (IsNumeric(ws.Range("E8").Value) And ws.Range("E8").Value <> 0) Then
                sinopacCount = sinopacCount + 1
            End If
        End If
    Next ws
    
    ' 統計元大申贖出入金紀錄
    yuanDaStats = "【元大申贖出入金紀錄】" & vbCrLf
    
    ' 元大名家-累積(入金)
    If Not IsError(Application.Worksheets("元大名家-累積(入金)").Range("D8").Value) Then
        If Application.Worksheets("元大名家-累積(入金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大名家-累積(入金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大名家-累積(入金)： " & Format(Application.Worksheets("元大名家-累積(入金)").Range("D8").Value, "#,##0.00") & " 元" & vbCrLf
        End If
    End If
    
    ' 元大名家-累積(出金)
    If Not IsError(Application.Worksheets("元大名家-累積(出金)").Range("D8").Value) Then
        If Application.Worksheets("元大名家-累積(出金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大名家-累積(出金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大名家-累積(出金)： " & Format(Application.Worksheets("元大名家-累積(出金)").Range("D8").Value, "#,##0.00") & " 單位" & vbCrLf
        End If
    End If
    
    ' 元大名家-月撥回(入金)
    If Not IsError(Application.Worksheets("元大名家-月撥回(入金)").Range("D8").Value) Then
        If Application.Worksheets("元大名家-月撥回(入金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大名家-月撥回(入金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大名家-月撥回(入金)： " & Format(Application.Worksheets("元大名家-月撥回(入金)").Range("D8").Value, "#,##0.00") & " 元" & vbCrLf
        End If
    End If
    
    ' 元大名家-月撥回(出金)
    If Not IsError(Application.Worksheets("元大名家-月撥回(出金)").Range("D8").Value) Then
        If Application.Worksheets("元大名家-月撥回(出金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大名家-月撥回(出金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大名家-月撥回(出金)： " & Format(Application.Worksheets("元大名家-月撥回(出金)").Range("D8").Value, "#,##0.00") & " 單位" & vbCrLf
        End If
    End If
    
    ' 元大ETF精選-累積(入金)
    If Not IsError(Application.Worksheets("元大ETF精選-累積(入金)").Range("D8").Value) Then
        If Application.Worksheets("元大ETF精選-累積(入金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大ETF精選-累積(入金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大ETF精選-累積(入金)： " & Format(Application.Worksheets("元大ETF精選-累積(入金)").Range("D8").Value, "#,##0.00") & " 元" & vbCrLf
        End If
    End If
    
    ' 元大ETF精選-累積(出金)
    If Not IsError(Application.Worksheets("元大ETF精選-累積(出金)").Range("D8").Value) Then
        If Application.Worksheets("元大ETF精選-累積(出金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大ETF精選-累積(出金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大ETF精選-累積(出金)： " & Format(Application.Worksheets("元大ETF精選-累積(出金)").Range("D8").Value, "#,##0.00") & " 單位" & vbCrLf
        End If
    End If
    
    ' 元大ETF精選-月撥回(入金)
    If Not IsError(Application.Worksheets("元大ETF精選-月撥回(入金)").Range("D8").Value) Then
        If Application.Worksheets("元大ETF精選-月撥回(入金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大ETF精選-月撥回(入金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大ETF精選-月撥回(入金)： " & Format(Application.Worksheets("元大ETF精選-月撥回(入金)").Range("D8").Value, "#,##0.00") & " 元" & vbCrLf
        End If
    End If
    
    ' 元大ETF精選-月撥回(出金)
    If Not IsError(Application.Worksheets("元大ETF精選-月撥回(出金)").Range("D8").Value) Then
        If Application.Worksheets("元大ETF精選-月撥回(出金)").Range("D8").Value = 0 Then
            yuanDaStats = yuanDaStats & "元大ETF精選-月撥回(出金)：無申贖" & vbCrLf
        Else
            yuanDaStats = yuanDaStats & "元大ETF精選-月撥回(出金)： " & Format(Application.Worksheets("元大ETF精選-月撥回(出金)").Range("D8").Value, "#,##0.00") & " 單位" & vbCrLf
        End If
    End If
    
    ' 關閉檔案
    wb.Close SaveChanges:=False
    
    ' 輸出結果
    summary = "【出入金統計】" & vbCrLf
    For i = LBound(trusteeName) To UBound(trusteeName)
        summary = summary & trusteeName(i) & "： " & trusteeStats(i) & " 張" & vbCrLf
    Next i
    
    ' 添加華南(元大保銀)出入金紀錄到總結
    summary = summary & vbCrLf & huanNanStats
    If outMoney <> "" Then
        summary = summary & outMoney
    Else
        summary = summary & "無出金紀錄" & vbCrLf
    End If
    
    summary = summary & vbCrLf & inMoney
    If inMoney = "入金：" & vbCrLf Then
        summary = summary & "無入金紀錄" & vbCrLf
    End If
    
    ' 添加元大申贖出入金紀錄到總結
    summary = summary & vbCrLf & yuanDaStats ' 添加元大申贖出入金紀錄到摘要
    
    ' 添加【保銀統計】部分
    summary = summary & vbCrLf & "【保銀統計】" & vbCrLf
    summary = summary & "復華(台新保銀)： " & fuhuaCount & " 張" & vbCrLf
    summary = summary & "瀚亞(台新保銀)： " & hanyahCount & " 張" & vbCrLf
    summary = summary & "中信(華南保銀)： " & sinopacCount & " 張" & vbCrLf
    
    ' 添加張數筆數統計到總結
    summary = summary & vbCrLf & "【張數筆數統計】" & vbCrLf
    summary = summary & "總張數：" & totalSheets & " 張" & vbCrLf
    summary = summary & "多筆張數：" & multiEntrySheets & " 張" & 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
    

注意事項與最佳實踐

• 數據一致性：確保所有相關工作表中的欄位名稱和數據格式保持一致，以避免條件判斷失敗。
• 錯誤處理：在開啟工作簿時加入錯誤處理機制，以防止路徑錯誤或檔案損壞導致巨集中斷。
• 代碼可讀性：適當添加注釋，說明每段程式碼的功能，提升代碼的可維護性。
• 效率優化：避免在循環內進行不必要的操作，如不必要的條件判斷或重複計算。
• 版本控制：在進行重大修改前，備份原始巨集程式碼，以便在出現問題時恢復。

總結

透過上述步驟，您可以成功在現有的VBA巨集中新增【保銀統計】部分，進一步提升出入金統計的全面性與精確度。這不僅有助於更好地了解不同保銀的業務表現，還能為未來的數據分析提供更豐富的資料支持。建議在實施後，對巨集進行多次測試，以確保所有統計結果的準確性與一致性。

參考資料

blog.coupler.io

Excel VBA CountIf: How to Count Specific Values - Coupler.io Blog

vocus.cc

Excel VBA教學：如何透過ChatGPT 神救援？ | 石頭來開講