在您的出入金統計VBA巨集中,新增【保銀統計】功能,可以幫助您更細緻地分析不同保管銀行的分頁數量。以下將詳細介紹如何在現有巨集基礎上,添加此功能。
根據以下規則,統計每家保管銀行符合條件的分頁數量:
以下是將【保銀統計】功能整合到現有VBA巨集中的具體步驟與程式碼示例:
在巨集的變數宣告區域,新增用於統計的變數:
' 保銀統計變數
Dim fuhuaTaiShin As Long
Dim hanYaTaiShin As Long
Dim ctbcHuaNan As Long
在統計開始前,初始化這些變數為0:
' 初始化保銀統計變數
fuhuaTaiShin = 0
hanYaTaiShin = 0
ctbcHuaNan = 0
在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
將統計結果整合至總結報告中:
' 整理【保銀統計】的結果
baoYinStats = "【保銀統計】" & vbCrLf
baoYinStats = baoYinStats & "復華(台新保銀): " & fuhuaTaiShin & " 張" & vbCrLf
baoYinStats = baoYinStats & "瀚亞(台新保銀): " & hanYaTaiShin & " 張" & vbCrLf
baoYinStats = baoYinStats & "中信(華南保銀): " & ctbcHuaNan & " 張" & vbCrLf
' 將結果添加到總結報告
summary = summary & vbCrLf & baoYinStats
以下是整合了【保銀統計】功能的完整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 筆
A1: 這表示在您的分頁中,沒有符合該條件的項目。請確認分頁中的A3、C3、D8及E8欄位是否正確填寫。
A2: 若需修改統計條件,請在VBA程式碼中調整相關的If條件語句。例如,變更受託人名稱或保管銀行名稱:
' 修改受託人或保管銀行名稱
If ws.Range("A3").Value Like "*受託人:新受託人*" And _
ws.Range("C3").Value Like "*保管銀行:新銀行*" Then
' 相關操作
End If
A3: 請檢查以下幾點:
通過在您的出入金統計VBA巨集中新增【保銀統計】功能,不僅可以更精確地掌握不同保管銀行的數據分布,還能提升整體數據分析的效率與準確性。上述步驟與程式碼示例,將協助您順利完成此功能的整合,並確保統計結果的可靠性。