全面的VBA腳本指南：查詢指定日期的基金淨值

高效自動化您的基金淨值查詢流程

主要要點

自動化數據收集：使用VBA腳本自動遍歷並查詢指定日期和區域的基金淨值。
動態URL構建：根據基金的區域自動生成查詢URL，確保數據的準確性和時效性。
錯誤處理與數據驗證：實現健全的錯誤處理機制，確保腳本的穩定運行和數據的完整性。

1. 解決方案概述

目標與需求分析

本指南旨在協助您編寫一個高效的VBA腳本，用於從指定的Excel工作表中查詢基金的淨值（NAV）。具體需求包括：

A欄：基金代碼
B欄：查詢日期（格式：yyyy/m/d）
C欄：填入查詢到的淨值
F欄：區域分類（"TW"表示境內，其他值表示境外，空白則忽略）
H欄：查詢淨值的URL

腳本將執行以下主要步驟：

讀取並整理所有有效的日期與區域組合。
根據基金代碼和區域動態構建查詢URL。
發送HTTP請求以獲取基金的淨值數據。
解析返回的數據並將淨值填入對應的C欄。

技術挑戰與解決方案

在實現自動化查詢過程中，可能會面臨以下挑戰：

多種區域處理：根據F欄的區域值選擇不同的URL格式。
網絡請求穩定性：處理可能出現的網絡延遲或請求失敗情況。
數據解析準確性：根據不同網站的HTML結構正確提取淨值數據。

為此，我們將採用如下策略：

使用字典對象來管理日期與區域的唯一組合。
實現健全的錯誤處理機制以應對網絡和解析過程中的問題。
根據不同區域的網站設計不同的解析函數，確保數據的準確提取。

2. VBA腳本的實現步驟

2.1 設置工作環境

在開始編寫VBA腳本之前，請確保已經設置好必要的參考：

打開Excel，按下 Alt + F11 進入VBA編輯器。
在“工具”菜單中選擇“參考”，勾選 “Microsoft XML, v6.0” 以支持HTTP請求。

2.2 讀取並整理日期與區域組合

首先，我們需要從指定的工作表中讀取所有有效的日期與區域組合，並將其存儲在字典對象中以避免重複。


Sub AggregateDateRegionCombination()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim sPath As String, sFile As String
    Dim lastRow As Long, i As Long
    Dim dtValue As String, region As String
    Dim key As String
    Dim dict As Object
    
    sPath = "G:\68_Vincent\試作工作表格紀錄\"
    sFile = "表格.xlsm"
    On Error Resume Next
    Set wbSource = Workbooks.Open(sPath & sFile, ReadOnly:=True)
    If wbSource Is Nothing Then
        MsgBox "無法開啟指定的 " & sPath & sFile, vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    Set wsSource = wbSource.Worksheets("速查境內外基金淨值")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        dtValue = Trim(wsSource.Cells(i, "B").Text)
        region = Trim(wsSource.Cells(i, "F").Text)
        
        If dtValue <> "" And region <> "" Then
            If UCase(region) = "TW" Then
                region = "TW"
            Else
                region = "IE"
            End If
            
            key = dtValue & ";" & region
            If Not dict.Exists(key) Then
                dict.Add key, Array(dtValue, region)
            End If
        End If
    Next i
    
    ' 輸出檢查結果
    Dim keyItem As Variant
    Debug.Print "-----------------------------------------"
    Debug.Print "【日期, 區域】組合(依B欄/F欄):"
    For Each keyItem In dict.Keys
        Debug.Print Replace(keyItem, ";", " ")
    Next keyItem
    Debug.Print "-----------------------------------------"
    
    wbSource.Close SaveChanges:=False
End Sub

這段代碼負責打開指定的Excel文件，讀取工作表“速查境內外基金淨值”中的B欄和F欄，並將有效的日期與區域組合添加到字典中，避免重複。

2.3 構建動態URL並發送HTTP請求

接下來，我們需要為每個基金代碼和區域構建相應的查詢URL，並發送HTTP請求以獲取基金的淨值數據。


Sub QueryNAVForEachRow()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim targetCode As String, queryDate As String, queryURL As String, region As String
    Dim navVal As Variant
    
    Set ws = ActiveSheet
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        targetCode = Trim(ws.Cells(i, "A").Value)
        queryDate = Trim(ws.Cells(i, "B").Value)
        region = Trim(ws.Cells(i, "F").Value)
        
        If UCase(region) <> "TW" And region <> "" Then
            region = "IE"
        End If
        
        If region = "" Then GoTo NextRow
        
        ' 構建URL
        If region = "TW" Then
            queryURL = "http://fundf10.eastmoney.com/jbgk_" & targetCode & ".html"
        Else
            queryURL = "https://www.morningstar.com.hk/fund/fundquote.aspx?fundid=" & targetCode
        End If
        
        ' 發送HTTP請求並解析淨值
        navVal = GetNAVFromWeb(queryURL, targetCode, queryDate, region)
        If Not IsError(navVal) Then
            ws.Cells(i, "C").Value = navVal
        Else
            ws.Cells(i, "C").Value = "查無資料"
        End If
        
NextRow:
    Next i
    
    MsgBox "網路查詢完成！", vbInformation
End Sub

Function GetNAVFromWeb(ByVal url As String, ByVal targetCode As String, _
                      ByVal queryDate As String, ByVal region As String) As Variant
    Dim httpReq As Object
    Dim respText As String
    Dim lines As Variant, oneLine As Variant
    Dim i As Long
    Dim nav As Variant
    
    On Error GoTo errHandler
    
    ' 建立XMLHTTP物件
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    
    httpReq.Open "GET", url, False
    httpReq.send
    If httpReq.Status <> 200 Then
        GetNAVFromWeb = CVErr(xlErrValue)
        Exit Function
    End If
    respText = httpReq.responseText
    Set httpReq = Nothing
    
    ' 解析HTML內容
    If region = "TW" Then
        nav = ExtractTWNetValue(respText, queryDate, targetCode)
    Else
        nav = ExtractIENetValue(respText, queryDate, targetCode)
    End If
    
    If nav <> "" Then
        GetNAVFromWeb = nav
    Else
        GetNAVFromWeb = CVErr(xlErrNA)
    End If
    Exit Function
    
errHandler:
    GetNAVFromWeb = CVErr(xlErrValue)
End Function

此部分腳本負責遍歷每一行數據，根據區域構建相應的URL，發送HTTP請求，並通過特定的解析函數提取淨值。

2.4 解析HTML內容並提取淨值

根據不同的區域，基金淨值可能位於不同的HTML結構中。因此，我們需要為每種區域設計專門的解析函數。


Function ExtractTWNetValue(html As String, queryDate As String, targetCode As String) As String
    Dim htmlDoc As Object
    Dim element As Object
    Dim nav As String
    
    Set htmlDoc = CreateObject("HTMLFILE")
    htmlDoc.Open
    htmlDoc.write html
    htmlDoc.Close
    
    ' 假設淨值位於某個特定的HTML元素中，需要根據實際情況調整
    On Error Resume Next
    Set element = htmlDoc.getElementById("fundNetValue")
    If Not element Is Nothing Then
        nav = Trim(element.innerText)
    Else
        nav = ""
    End If
    On Error GoTo 0
    
    ExtractTWNetValue = nav
End Function

Function ExtractIENetValue(html As String, queryDate As String, targetCode As String) As String
    Dim htmlDoc As Object
    Dim elements As Object
    Dim element As Object
    Dim nav As String
    Dim targetLine As String
    
    Set htmlDoc = CreateObject("HTMLFILE")
    htmlDoc.Open
    htmlDoc.write html
    htmlDoc.Close
    
    ' 假設淨值位於<span class="price">內
    On Error Resume Next
    Set elements = htmlDoc.getElementsByTagName("span")
    For Each element In elements
        If element.className = "price" Then
            nav = Trim(element.innerText)
            Exit For
        End If
    Next element
    On Error GoTo 0
    
    ExtractIENetValue = nav
End Function

這些函數負責解析返回的HTML內容，根據基金的區域（境內或境外）選擇合適的解析方法來提取淨值數據。請根據實際的HTML結構調整元素的選擇器。

2.5 完整的VBA腳本

綜合上述步驟，以下是完整的VBA腳本，實現自動化查詢基金淨值的功能：


Sub 查詢基金淨值()
    ' 聚合日期與區域組合
    Call AggregateDateRegionCombination
    
    ' 查詢並填入淨值
    Call QueryNAVForEachRow
End Sub

Sub AggregateDateRegionCombination()
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim sPath As String, sFile As String
    Dim lastRow As Long, i As Long
    Dim dtValue As String, region As String
    Dim key As String
    Dim dict As Object
    
    sPath = "G:\68_Vincent\試作工作表格紀錄\"
    sFile = "表格.xlsm"
    On Error Resume Next
    Set wbSource = Workbooks.Open(sPath & sFile, ReadOnly:=True)
    If wbSource Is Nothing Then
        MsgBox "無法開啟指定的 " & sPath & sFile, vbCritical
        Exit Sub
    End If
    On Error GoTo 0
    
    Set wsSource = wbSource.Worksheets("速查境內外基金淨值")
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        dtValue = Trim(wsSource.Cells(i, "B").Text)
        region = Trim(wsSource.Cells(i, "F").Text)
        
        If dtValue <> "" And region <> "" Then
            If UCase(region) = "TW" Then
                region = "TW"
            Else
                region = "IE"
            End If
            
            key = dtValue & ";" & region
            If Not dict.Exists(key) Then
                dict.Add key, Array(dtValue, region)
            End If
        End If
    Next i
    
    ' 輸出檢查結果
    Dim keyItem As Variant
    Debug.Print "-----------------------------------------"
    Debug.Print "【日期, 區域】組合(依B欄/F欄):"
    For Each keyItem In dict.Keys
        Debug.Print Replace(keyItem, ";", " ")
    Next keyItem
    Debug.Print "-----------------------------------------"
    
    wbSource.Close SaveChanges:=False
End Sub

Sub QueryNAVForEachRow()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim targetCode As String, queryDate As String, queryURL As String, region As String
    Dim navVal As Variant
    
    Set ws = ThisWorkbook.Worksheets("速查境內外基金淨值")
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To lastRow
        targetCode = Trim(ws.Cells(i, "A").Value)
        queryDate = Trim(ws.Cells(i, "B").Value)
        region = Trim(ws.Cells(i, "F").Value)
        
        If UCase(region) <> "TW" And region <> "" Then
            region = "IE"
        End If
        
        If region = "" Then GoTo NextRow
        
        ' 構建URL
        If region = "TW" Then
            queryURL = "http://fundf10.eastmoney.com/jbgk_" & targetCode & ".html"
        Else
            queryURL = "https://www.morningstar.com.hk/fund/fundquote.aspx?fundid=" & targetCode
        End If
        
        ' 發送HTTP請求並解析淨值
        navVal = GetNAVFromWeb(queryURL, targetCode, queryDate, region)
        If Not IsError(navVal) Then
            ws.Cells(i, "C").Value = navVal
        Else
            ws.Cells(i, "C").Value = "查無資料"
        End If
        
NextRow:
    Next i
    
    MsgBox "網路查詢完成！", vbInformation
End Sub

Function GetNAVFromWeb(ByVal url As String, ByVal targetCode As String, _
                      ByVal queryDate As String, ByVal region As String) As Variant
    Dim httpReq As Object
    Dim respText As String
    Dim nav As Variant
    
    On Error GoTo errHandler
    
    ' 建立XMLHTTP物件
    Set httpReq = CreateObject("MSXML2.XMLHTTP")
    
    httpReq.Open "GET", url, False
    httpReq.send
    If httpReq.Status <> 200 Then
        GetNAVFromWeb = CVErr(xlErrValue)
        Exit Function
    End If
    respText = httpReq.responseText
    Set httpReq = Nothing
    
    ' 解析HTML內容
    If region = "TW" Then
        nav = ExtractTWNetValue(respText, queryDate, targetCode)
    Else
        nav = ExtractIENetValue(respText, queryDate, targetCode)
    End If
    
    If nav <> "" Then
        GetNAVFromWeb = nav
    Else
        GetNAVFromWeb = CVErr(xlErrNA)
    End If
    Exit Function
    
errHandler:
    GetNAVFromWeb = CVErr(xlErrValue)
End Function

Function ExtractTWNetValue(html As String, queryDate As String, targetCode As String) As String
    Dim htmlDoc As Object
    Dim element As Object
    Dim nav As String
    
    Set htmlDoc = CreateObject("HTMLFILE")
    htmlDoc.Open
    htmlDoc.write html
    htmlDoc.Close
    
    ' 假設淨值位於某個特定的HTML元素中，需要根據實際情況調整
    On Error Resume Next
    Set element = htmlDoc.getElementById("fundNetValue")
    If Not element Is Nothing Then
        nav = Trim(element.innerText)
    Else
        nav = ""
    End If
    On Error GoTo 0
    
    ExtractTWNetValue = nav
End Function

Function ExtractIENetValue(html As String, queryDate As String, targetCode As String) As String
    Dim htmlDoc As Object
    Dim elements As Object
    Dim element As Object
    Dim nav As String
    
    Set htmlDoc = CreateObject("HTMLFILE")
    htmlDoc.Open
    htmlDoc.write html
    htmlDoc.Close
    
    ' 假設淨值位於<span class="price">內
    On Error Resume Next
    Set elements = htmlDoc.getElementsByTagName("span")
    For Each element In elements
        If element.className = "price" Then
            nav = Trim(element.innerText)
            Exit For
        End If
    Next element
    On Error GoTo 0
    
    ExtractIENetValue = nav
End Function

此完整腳本涵蓋了從讀取數據、構建URL、發送請求到解析並填入淨值的全過程。確保根據實際的HTML結構調整解析函數，以準確提取淨值數據。

2.6 範例輸出

以下是一個範例輸出表格，展示了執行腳本後的數據填充情況：

A欄基金代碼	B欄日期	F欄區域	C欄淨值
BCAAB002	2025/01/21	IE	10.42
BCAAB003	2025/01/22	TW	9.78
BCAAB004	2025/01/24	IE	11.05

3. 進階考量與最佳實踐

3.1 錯誤處理與日誌記錄

為了確保腳本在遇到問題時能夠穩定運行，建議實施以下錯誤處理措施：

在每個主要步驟中加入錯誤捕捉機制，避免腳本中斷。
將錯誤信息記錄到專門的工作表或日誌文件中，便於後續分析和調試。
對HTTP請求的響應狀態碼進行檢查，確保請求成功。

例如，在發送HTTP請求的函數中加入狀態碼檢查：


If httpReq.Status <> 200 Then
    GetNAVFromWeb = CVErr(xlErrValue)
    Exit Function
End If

3.2 效能優化

當處理大量數據時，腳本的執行效率尤為重要。以下是一些效能優化的建議：

屏幕更新：在腳本開始時禁用屏幕更新，結束時重新啟用，以減少不必要的資源消耗。
```
Application.ScreenUpdating = False
' 腳本代碼
Application.ScreenUpdating = True
      
```
使用變量：盡量使用變量來存儲重複使用的對象，如工作表和工作簿。
避免使用Select和Activate：直接操作對象，避免使用Select和Activate方法，這樣可以顯著提高腳本的執行速度。

3.3 多線程處理

VBA本身不支持多線程，但可以通過分批處理或使用異步請求的方式來模擬多線程處理，以提高效率。例如，可以將查詢過程分成多個階段，逐步處理不同部分的數據。

3.4 數據驗證與清理

確保輸入數據的正確性是獲取準確結果的前提。建議在腳本中加入以下數據驗證步驟：

檢查基金代碼是否符合預期格式。
確保查詢日期的格式正確（yyyy/m/d）。
確認URL是否有效並可訪問。

例如，可以使用正則表達式來驗證基金代碼：


Function IsValidFundCode(code As String) As Boolean
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = "^[A-Z]{6}\d{3}$"
    regex.IgnoreCase = True
    IsValidFundCode = regex.Test(code)
End Function

3.5 支持多平台數據來源

為了獲取更全面和準確的基金淨值數據，可以考慮整合多個數據來源。例如，除了東方財富網和晨星網，還可以新增Yahoo Finance、Bloomberg等平台，根據需求擴展數據來源，提高數據可靠性。

4. 範例展示與測試

4.1 範例Excel文件

假設您的Excel文件“表格.xlsm”中，“速查境內外基金淨值”工作表包含以下數據：

A欄基金代碼	B欄日期	F欄區域	H欄查詢URL
BCAAB002	2025/01/21	IE	http://fundf10.eastmoney.com/jbgk_BCAAB002.html
BCAAB003	2025/01/22	TW	http://fundf10.eastmoney.com/jbgk_BCAAB003.html
BCAAB004	2025/01/24	IE	http://fundf10.eastmoney.com/jbgk_BCAAB004.html

4.2 執行腳本

按照以下步驟執行腳本以填充C欄的淨值數據：

打開Excel文件，按下 Alt + F11 進入VBA編輯器。
將上述完整的VBA腳本粘貼到新模塊中。
回到Excel，按下 Alt + F8，選擇 查詢基金淨值，然後點擊“運行”。

4.3 成功結果

執行成功後，您的Excel表格將自動填充C欄的淨值數據，如下所示：

A欄基金代碼	B欄日期	F欄區域	C欄淨值	H欄查詢URL
BCAAB002	2025/01/21	IE	10.42	http://fundf10.eastmoney.com/jbgk_BCAAB002.html
BCAAB003	2025/01/22	TW	9.78	http://fundf10.eastmoney.com/jbgk_BCAAB003.html
BCAAB004	2025/01/24	IE	11.05	http://fundf10.eastmoney.com/jbgk_BCAAB004.html

4.4 常見問題與解決方案

在使用腳本過程中，您可能會遇到以下常見問題：

無法開啟指定的Excel文件：請檢查文件路徑和文件名是否正確，並確保文件未被其他程序佔用。
無法獲取淨值數據：確認URL是否正確，並檢查網站的HTML結構是否改變。
淨值顯示為“查無資料”：可能是基金代碼或日期不正確，或者網站未提供該日期的淨值數據。

遇到問題時，建議通過調試模式（按下 F8）逐步執行腳本，查看每一步的執行情況和變量值，以便定位問題所在。

5. 結論

通過本指南提供的詳細步驟和範例代碼，您可以輕鬆地自動化查詢和填充基金的淨值數據，提升工作效率並減少手動操作的錯誤。當然，隨著應用需求的變化，您可能需要對腳本進行相應的調整和優化，以適應不同的數據來源和網站結構。

建議在實際應用中持續優化腳本的效能和穩定性，並根據需要擴展其功能，如支持更多的數據來源、增強錯誤處理能力等，以滿足日益增長的業務需求。

參考資料

excel-easy.com

Vlookup in Excel VBA - Step by Step Tutorial - Excel Easy

learn.microsoft.com

WorksheetFunction.VLookup method (Excel) - Microsoft Learn

stackoverflow.com

VBA code to lookup value in range and return cell across value - StackOverflow

Last updated February 3, 2025