如果用Excel管理股票持仓,别再手动抄写股价了

Public Sub UpdateAllPrices()    Dim ws As Worksheet    Dim lastRow As Long    Dim i As Long    Dim ticker As String    Dim price As Variant    Set ws = ThisWorkbook.Sheets("股价数据源")    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row    Application.ScreenUpdating = False    Application.StatusBar = "正在更新股价..."    Dim successCount As Long    Dim failCount As Long    successCount = 0    failCount = 0    For i = 2 To lastRow        ticker = Trim(CStr(ws.Cells(i, 1).Value))        If ticker = "" Or ticker = "代码" Then GoTo NextTicker        Application.StatusBar = "正在更新: " & ws.Cells(i, 2).Value & _                                " (" & i - 1 & "/" & lastRow - 1 & ")"        price = GetYahooPrice(ticker)        If IsNumeric(price) Then            ws.Cells(i, 4).Value = CDbl(price)            ws.Cells(i, 5).Value = Now()            successCount = successCount + 1        Else            ws.Cells(i, 4).Value = "ERROR"            ws.Cells(i, 5).Value = CStr(price)            failCount = failCount + 1        End If        Application.Wait Now + TimeValue("00:00:01")NextTicker:    Next i    Application.StatusBar = False    Application.ScreenUpdating = True    MsgBox "股价更新完成！" & vbCrLf & _           "成功: " & successCount & " 只" & vbCrLf & _           "失败: " & failCount & " 只" & vbCrLf & _           "更新时间: " & Format(Now(), "yyyy-mm-dd hh:mm:ss"), _           vbInformation, "股价更新"End SubFunction GetYahooPrice(ticker As String) As Variant    Dim url As String    Dim response As String    url = "https://query1.finance.yahoo.com/v8/finance/chart/" & _          UrlEncode(ticker) & _          "?range=1d&interval=1d"#If Mac Then    On Error GoTo FinalError    ' Mac: only use curl    Dim scriptStr As String    scriptStr = "do shell script ""curl -s -L " & _                "-H 'User-Agent: Mozilla/5.0' " & _                "'" & url & "'"""    response = MacScript(scriptStr)    GetYahooPrice = ParsePrice(response)    Exit Function#Else    On Error GoTo TryAlt    ' Windows: XMLHTTP    Dim http As Object    Set http = CreateObject("MSXML2.XMLHTTP")    http.Open "GET", url, False    http.setRequestHeader "User-Agent", "Mozilla/5.0"    http.Send    If http.Status = 200 Then        response = http.responseText        GetYahooPrice = ParsePrice(response)    Else        GetYahooPrice = "HTTP " & http.Status    End If    Set http = Nothing    Exit FunctionTryAlt:    On Error GoTo FinalError    ' Windows fallback: Microsoft.XMLHTTP    Dim xmlhttp As Object    Set xmlhttp = CreateObject("Microsoft.XMLHTTP")    xmlhttp.Open "GET", url, False    xmlhttp.setRequestHeader "User-Agent", "Mozilla/5.0"    xmlhttp.Send    If xmlhttp.Status = 200 Then        response = xmlhttp.responseText        GetYahooPrice = ParsePrice(response)    Else        GetYahooPrice = "HTTP " & xmlhttp.Status    End If    Set xmlhttp = Nothing    Exit Function#End IfFinalError:    GetYahooPrice = "Error: " & Err.DescriptionEnd FunctionFunction ParsePrice(jsonText As String) As Variant    Dim searchKey As String    Dim pos As Long    Dim endPos As Long    Dim priceStr As String    searchKey = """regularMarketPrice"":"    pos = InStr(1, jsonText, searchKey)    If pos = 0 Then        ParsePrice = "无法解析"        Exit Function    End If    pos = pos + Len(searchKey)    endPos = InStr(pos, jsonText, ",")    If endPos = 0 Then endPos = InStr(pos, jsonText, "}")    priceStr = Trim(Mid(jsonText, pos, endPos - pos))    If IsNumeric(priceStr) Then        ParsePrice = CDbl(priceStr)    Else        ParsePrice = "解析失败"    End IfEnd FunctionFunction UrlEncode(ByVal s As String) As String    Dim i As Long, ch As String, code As Integer    Dim out As String    For i = 1 To Len(s)        ch = Mid$(s, i, 1)        code = AscW(ch)        Select Case code            Case 48 To 57, 65 To 90, 97 To 122, 45, 46, 95, 126                out = out & ch            Case 32                out = out & "%20"            Case Else                out = out & "%" & Right$("0" & Hex(code), 2)        End Select    Next i    UrlEncode = outEnd Function

💡 代码说明

脚本包含 4 个函数：UpdateAllPrices（主入口，遍历股票列表）、GetYahooPrice（调用 Yahoo Finance API，Mac 用 curl，Windows 用 XMLHTTP）、ParsePrice（从 JSON 中提取价格）、UrlEncode（URL 编码处理）。每次请求间隔 1 秒，避免触发频率限制。

日常使用

设置好之后，日常操作非常简单：

✅ 每次更新只需一步

工具 → 宏 → UpdateAllPrices → 运行

等待约 30 秒（取决于股票数量），弹窗提示更新完成后，所有数据已是最新。

▎添加新股票

1. 在「股价数据源」Sheet 末尾新增一行，A 列填 Yahoo Finance 代码，B 列填名称
2. 在持仓表的市价单元格写公式引用 =股价数据源!D{行号}
3. 下次运行宏时自动覆盖

常见问题

Q: Mac 上运行报错怎么办？

确认文件已保存为 .xlsm 格式。在 Mac Excel 中：偏好设置 → 安全性 → 勾选「启用所有宏」。首次运行时允许网络访问权限。

Q: 某只股票显示 ERROR？

检查 A 列的 Yahoo Finance 代码是否正确。可以在 finance.yahoo.com 搜索股票名称来确认正确代码。

Q: 可以自动定时运行吗？

Excel VBA 本身不支持后台定时。但可以用 Application.OnTime 在 Excel 打开期间定时执行，或者用操作系统的定时任务来打开 Excel 并触发宏。对于投资组合跟踪来说，手动运行一次已经足够方便。

Q: Yahoo Finance API 会收费吗？

这里用的是 Yahoo Finance 的公开 chart API，免费且无需注册。价格有约 15 分钟延迟，对于投资组合日常跟踪完全够用。