Ithy Logo

全面優化您的VBA巨集:新增【保銀統計】功能

深入解析並擴展您的出入金統計VBA巨集,提升數據分析效率

VBA programming in Excel

三個主要要點

  • 精確統計規則:根據指定條件,準確計算復華、瀚亞及中信保管銀行的分頁數量。
  • 高效VBA程式碼整合:在現有巨集中無縫新增【保銀統計】功能,提升巨集的功能性。
  • 清晰的結果展示:統計結果以易讀格式呈現,方便後續數據分析與決策。

【保銀統計】功能說明

在您的出入金統計VBA巨集中,新增【保銀統計】功能,可以幫助您更細緻地分析不同保管銀行的分頁數量。以下將詳細介紹如何在現有巨集基礎上,添加此功能。

統計規則概述

根據以下規則,統計每家保管銀行符合條件的分頁數量:

  • 復華(台新保銀):搜尋分頁中A3欄位為「受託人:復華投信」,且C3欄位為「保管銀行:台新銀行」,並且分頁中的D8或E8任一欄位裡有不為0或空白的數值的分頁數量。
  • 瀚亞(台新保銀):搜尋分頁中A3欄位為「受託人:瀚亞投信」,且C3欄位為「保管銀行:台新銀行」,並且分頁中的D8或E8任一欄位裡有不為0或空白的數值的分頁數量。
  • 中信(華南保銀):搜尋分頁中A3欄位為「受託人:中國信託投信」,且C3欄位為「保管銀行:華南銀行」,並且分頁中的D8或E8任一欄位裡有不為0或空白的數值的分頁數量。

新增VBA巨集程式碼

以下是將【保銀統計】功能整合到現有VBA巨集中的具體步驟與程式碼示例:

1. 變數宣告

在巨集的變數宣告區域,新增用於統計的變數:


' 保銀統計變數
Dim fuhuaTaiShin As Long
Dim hanYaTaiShin As Long
Dim ctbcHuaNan As Long
  

2. 初始化變數

在統計開始前,初始化這些變數為0:


' 初始化保銀統計變數
fuhuaTaiShin = 0
hanYaTaiShin = 0
ctbcHuaNan = 0
  

3. 分頁遍歷與條件檢查

在For Each循環中,根據指定條件檢查每個分頁:


' 開始統計
For Each ws In wb.Sheets
    ' 統計復華(台新保銀)
    If ws.Range("A3").Value Like "*受託人:復華投信*" And _
       ws.Range("C3").Value Like "*保管銀行:台新銀行*" 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
            fuhuaTaiShin = fuhuaTaiShin + 1
        End If
    End If

    ' 統計瀚亞(台新保銀)
    If ws.Range("A3").Value Like "*受託人:瀚亞投信*" And _
       ws.Range("C3").Value Like "*保管銀行:台新銀行*" 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
            hanYaTaiShin = hanYaTaiShin + 1
        End If
    End If

    ' 統計中信(華南保銀)
    If ws.Range("A3").Value Like "*受託人:中國信託投信*" And _
       ws.Range("C3").Value Like "*保管銀行:華南銀行*" 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
            ctbcHuaNan = ctbcHuaNan + 1
        End If
    End If
Next ws
  

4. 統計結果整理

將統計結果整合至總結報告中:


' 整理【保銀統計】的結果
baoYinStats = "【保銀統計】" & vbCrLf
baoYinStats = baoYinStats & "復華(台新保銀): " & fuhuaTaiShin & " 張" & vbCrLf
baoYinStats = baoYinStats & "瀚亞(台新保銀): " & hanYaTaiShin & " 張" & vbCrLf
baoYinStats = baoYinStats & "中信(華南保銀): " & ctbcHuaNan & " 張" & vbCrLf

' 將結果添加到總結報告
summary = summary & vbCrLf & baoYinStats
  

完整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 fuhuaTaiShin As Long
    Dim hanYaTaiShin As Long
    Dim ctbcHuaNan As Long
    
    ' 初始化數值
    fuhuaTaiShin = 0
    hanYaTaiShin = 0
    ctbcHuaNan = 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 Like "*受託人:復華投信*" And _
           ws.Range("C3").Value Like "*保管銀行:台新銀行*" 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
                fuhuaTaiShin = fuhuaTaiShin + 1
            End If
        End If

        ' 統計瀚亞(台新保銀)
        If ws.Range("A3").Value Like "*受託人:瀚亞投信*" And _
           ws.Range("C3").Value Like "*保管銀行:台新銀行*" 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
                hanYaTaiShin = hanYaTaiShin + 1
            End If
        End If

        ' 統計中信(華南保銀)
        If ws.Range("A3").Value Like "*受託人:中國信託投信*" And _
           ws.Range("C3").Value Like "*保管銀行:華南銀行*" 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
                ctbcHuaNan = ctbcHuaNan + 1
            End If
        End If
    Next ws
    
    ' 統計元大申贖出入金紀錄
    ' [此處省略元大相關統計程式碼,請參照原始巨集]
    
    ' 整理【保銀統計】的結果
    baoYinStats = "【保銀統計】" & vbCrLf
    baoYinStats = baoYinStats & "復華(台新保銀): " & fuhuaTaiShin & " 張" & vbCrLf
    baoYinStats = baoYinStats & "瀚亞(台新保銀): " & hanYaTaiShin & " 張" & vbCrLf
    baoYinStats = baoYinStats & "中信(華南保銀): " & ctbcHuaNan & " 張" & vbCrLf
    
    ' 將結果添加到總結報告
    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 & baoYinStats
    
    ' 添加張數筆數統計到總結
    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
  

結果展示

執行上述巨集後,統計結果將以以下格式呈現在結果檔案中:


【出入金統計】
復華投信:10 張
富蘭克林華美投信:5 張
凱基投信:8 張
...
【華南(元大保銀)出入金紀錄】
出金:
1,000.00 單位
500.00 單位
入金:
2,000.00 元

【保銀統計】
復華(台新保銀):10 張
瀚亞(台新保銀):8 張
中信(華南保銀):5 張

【張數筆數統計】
總張數:23 張
多筆張數:4 張
總筆數:30 筆
  

常見問題與解答

Q1: 為什麼統計結果中某些項目顯示0張?

A1: 這表示在您的分頁中,沒有符合該條件的項目。請確認分頁中的A3、C3、D8及E8欄位是否正確填寫。

Q2: 如何修改統計條件?

A2: 若需修改統計條件,請在VBA程式碼中調整相關的If條件語句。例如,變更受託人名稱或保管銀行名稱:


' 修改受託人或保管銀行名稱
If ws.Range("A3").Value Like "*受託人:新受託人*" And _
   ws.Range("C3").Value Like "*保管銀行:新銀行*" Then
    ' 相關操作
End If
  

Q3: 統計結果未正確顯示,應如何排查?

A3: 請檢查以下幾點:

  • 確認分頁中A3、C3、D8及E8欄位的內容格式是否符合要求。
  • 確保VBA巨集在運行時沒有錯誤訊息。
  • 檢查檔案路徑是否正確,並確保檔案存在。

總結

通過在您的出入金統計VBA巨集中新增【保銀統計】功能,不僅可以更精確地掌握不同保管銀行的數據分布,還能提升整體數據分析的效率與準確性。上述步驟與程式碼示例,將協助您順利完成此功能的整合,並確保統計結果的可靠性。


參考資料


Last updated January 22, 2025
Ask me more