全面的VBA腳本指南：自動化基金淨值覆核流程

高效管理Excel工作簿與自動化數據處理的最佳實踐

主要收穫

動態檔案搜尋與處理：自動尋找並操作符合特定命名規則的Excel檔案，提升工作效率。
數據自動化複製與貼上：精確選取並轉移資料至指定位置，同時考慮年份轉換與格式調整。
網頁內容整合與資料剖析：自動抓取網絡數據並進行進一步分析，確保數據的即時性與準確性。

概述

本指南將詳細介紹如何使用VBA（Visual Basic for Applications）編寫一個功能全面的腳本，自動化處理Excel工作簿中的數據。該腳本將完成以下任務：

動態查找並開啟特定命名格式的Excel檔案。
複製選定範圍的數據並貼至目標工作表的指定單元格。
執行指定模組中的子程序以清理數據。
從指定網址抓取網頁內容並貼至對應的工作表。
在多個工作表中執行資料剖析子程序，並自動處理中途的提示窗口。
跳轉至特定工作表並開啟CSV文件。

詳細步驟

1. 動態尋找並開啟特定命名的Excel檔案

首先，需要在指定目錄中搜尋名稱符合「Bloomberg 報價-YYYYMMDD.xlsm」格式的Excel檔案，其中「YYYYMMDD」代表變動的日期部分。此部分將使用VBA的FileSystemObject來遍歷目錄並找到符合條件的檔案。

VBA代碼示範：


Function FindBloombergFile(FolderPath As String) As String
    Dim fso As Object
    Dim folder As Object
    Dim file As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(FolderPath)
    
    For Each file In folder.Files
        If file.Name Like "Bloomberg 報價-########.xlsm" Then
            FindBloombergFile = file.Path
            Exit Function
        End If
    Next file
    
    FindBloombergFile = ""
End Function

上述函數將遍歷指定的目錄，並返回第一個符合命名模式的檔案路徑。如果未找到符合條件的檔案，則返回空字符串。

2. 複製選定範圍的數據並貼至目標工作表

找到並開啟Bloomberg報價檔案後，將當前選定的範圍複製並貼至「基金淨值覆核表-YYYMMDD」的「基金淨值覆核表」工作表的E5欄位。此處需要將西元年轉換為民國年。

西元年轉民國年轉換：


Function ConvertToROCYear(ADYear As Integer) As String
    ConvertToROCYear = CStr(ADYear - 1911)
End Function

此函數將西元年份轉換為民國年份。例如，2025年將轉換為114年。

數據複製與貼上：


Sub CopySelectedData()
    Dim sourceWb As Workbook
    Dim targetWb As Workbook
    Dim sourcePath As String
    Dim targetPath As String
    Dim rocYear As String
    Dim fileDate As String
    Dim folderPath As String
    
    folderPath = "C:\YourPath\" ' 替換為您的目錄路徑
    sourcePath = FindBloombergFile(folderPath)
    
    If sourcePath = "" Then
        MsgBox "未找到符合條件的Bloomberg報價檔案。", vbExclamation
        Exit Sub
    End If
    
    Set sourceWb = Workbooks.Open(sourcePath)
    
    ' 獲取當前日期部分
    fileDate = Format(Date, "yyyymmdd")
    rocYear = ConvertToROCYear(Year(Date))
    
    targetPath = "C:\YourPath\基金淨值覆核表-" & rocYear & Format(Date, "mmdd") & ".xlsm"
    
    On Error Resume Next
    Set targetWb = Workbooks.Open(targetPath)
    On Error GoTo 0
    
    If targetWb Is Nothing Then
        MsgBox "無法開啟目標工作簿：" & targetPath, vbExclamation
        sourceWb.Close False
        Exit Sub
    End If
    
    ' 複製並貼上數據
    sourceWb.ActiveSheet.Selection.Copy
    targetWb.Sheets("基金淨值覆核表").Range("E5").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    sourceWb.Close False
End Sub

此段代碼將選定的數據從Bloomberg報價工作簿複製並貼至目標工作簿的E5單元格，同時處理年份轉換。

3. 執行指定子程序以清理數據

在數據貼上後，需要執行目標工作簿中的Module21模組下的「清除()」子程序以進行數據清理。

執行子程序：


Sub RunClearMacro(targetWb As Workbook)
    On Error GoTo ErrorHandler
    Application.Run "'" & targetWb.Name & "'!Module21.清除"
    Exit Sub
    
ErrorHandler:
    MsgBox "執行清除子程序時出錯：" & Err.Description, vbCritical
End Sub

透過Application.Run方法，調用指定工作簿中的子程序，並包含基本的錯誤處理以防止腳本中斷。

4. 從指定網址抓取網頁內容並貼至對應工作表

根據「fundDJ網址」工作表中C2至C5儲存格中的網址，抓取網頁內容並分別貼至「T-1 境外」、「T-2 境外」、「T-1 境內」、「T-2 境內」等工作表。

抓取網頁內容：


Sub FetchAndPasteWebContent(targetWb As Workbook)
    Dim wsFundDJ As Worksheet
    Dim urls(1 To 4) As String
    Dim destinations(1 To 4) As String
    Dim i As Integer
    Dim http As Object
    Dim responseText As String
    
    Set wsFundDJ = targetWb.Sheets("fundDJ網址")
    
    ' 定義URL與目標工作表的對應
    urls(1) = wsFundDJ.Range("C2").Value
    urls(2) = wsFundDJ.Range("C3").Value
    urls(3) = wsFundDJ.Range("C4").Value
    urls(4) = wsFundDJ.Range("C5").Value
    
    destinations(1) = "T-1 境外"
    destinations(2) = "T-2 境外"
    destinations(3) = "T-1 境內"
    destinations(4) = "T-2 境內"
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    For i = 1 To 4
        If urls(i) <> "" Then
            http.Open "GET", urls(i), False
            http.send
            responseText = http.responseText
            targetWb.Sheets(destinations(i)).Range("A1").Value = responseText
        End If
    Next i
End Sub

此函數使用MSXML2.XMLHTTP對象發送HTTP請求，抓取網頁內容並將其貼至對應的工作表。

5. 在多個工作表中執行資料剖析子程序

在「T-1 境外」、「T-2 境外」、「T-1 境內」、「T-2 境內」等工作表中，執行Module22模組下的「資料剖析()」子程序，並自動處理中途的提示窗口。

執行資料剖析子程序：


Sub RunAnalysisMacros(targetWb As Workbook)
    Dim sheetsToAnalyze As Variant
    Dim sheetName As Variant
    
    sheetsToAnalyze = Array("T-1 境外", "T-2 境外", "T-1 境內", "T-2 境內")
    
    Application.DisplayAlerts = False
    
    For Each sheetName In sheetsToAnalyze
        On Error Resume Next
        targetWb.Sheets(sheetName).Activate
        Application.Run "'" & targetWb.Name & "'!Module22.資料剖析"
        If Err.Number <> 0 Then
            MsgBox "執行資料剖析時出錯於 " & sheetName & "：" & Err.Description, vbCritical
            Err.Clear
        End If
        On Error GoTo 0
    Next sheetName
    
    Application.DisplayAlerts = True
End Sub

此段代碼將依序在指定的工作表中執行資料剖析子程序，並關閉提示窗口以自動確認任何詢問。

6. 跳轉至特定工作表並開啟CSV文件

最後，腳本將跳轉至「基金淨值覆核表」工作表，並開啟指定路徑下的CSV文件。

跳轉與開啟CSV文件：


Sub FinalizeProcess(targetWb As Workbook)
    ' 跳轉至基金淨值覆核表工作表
    targetWb.Sheets("基金淨值覆核表").Activate
    
    ' 開啟CSV文件
    Dim csvPath As String
    csvPath = "C:\Users\VILEE00\Downloads\FundPriceTop.csv"
    
    On Error Resume Next
    Workbooks.Open csvPath
    If Err.Number <> 0 Then
        MsgBox "無法開啟CSV文件：" & csvPath, vbCritical
        Err.Clear
    End If
    On Error GoTo 0
End Sub

此段代碼將跳轉至指定工作表，並嘗試開啟CSV文件。如果路徑錯誤或文件不存在，將顯示錯誤訊息。

完整VBA腳本

以下是將上述各步驟整合成一個完整的VBA腳本，實現自動化處理的完整流程：

完整腳本示範：


Sub AutomatedFundReviewProcess()
    Dim folderPath As String
    Dim sourcePath As String
    Dim targetPath As String
    Dim rocYear As String
    Dim fileDate As String
    Dim sourceWb As Workbook
    Dim targetWb As Workbook
    
    ' 設定資料夾路徑
    folderPath = "C:\YourPath\" ' 替換為您的實際路徑
    
    ' 尋找Bloomberg報價檔案
    sourcePath = FindBloombergFile(folderPath)
    If sourcePath = "" Then
        MsgBox "未找到符合條件的Bloomberg報價檔案。", vbExclamation
        Exit Sub
    End If
    
    ' 開啟源工作簿
    Set sourceWb = Workbooks.Open(sourcePath)
    
    ' 獲取當前日期
    fileDate = Format(Date, "yyyymmdd")
    rocYear = ConvertToROCYear(Year(Date))
    
    ' 設定目標工作簿路徑
    targetPath = folderPath & "基金淨值覆核表-" & rocYear & Format(Date, "mmdd") & ".xlsm"
    
    ' 開啟目標工作簿
    On Error Resume Next
    Set targetWb = Workbooks.Open(targetPath)
    On Error GoTo 0
    If targetWb Is Nothing Then
        MsgBox "無法開啟目標工作簿：" & targetPath, vbExclamation
        sourceWb.Close False
        Exit Sub
    End If
    
    ' 複製選定範圍並貼上
    sourceWb.ActiveSheet.Selection.Copy
    targetWb.Sheets("基金淨值覆核表").Range("E5").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    ' 關閉源工作簿
    sourceWb.Close False
    
    ' 執行清除子程序
    RunClearMacro targetWb
    
    ' 抓取並貼上網頁內容
    FetchAndPasteWebContent targetWb
    
    ' 執行資料剖析子程序
    RunAnalysisMacros targetWb
    
    ' 跳轉至基金淨值覆核表並開啟CSV文件
    FinalizeProcess targetWb
    
    MsgBox "VBA作業已全部完成！", vbInformation
End Sub

此腳本將依序執行所有必要的步驟，自動化處理基金淨值覆核的相關操作，確保過程高效且無誤。