【VBA】excel获取股票实时行情（历史数据，基金数据下载）

0. 效果展示与获取

作品：https://mbd.pub/o/bread/aJaUmplq

需要定制可以联系我：不过不便宜。

🟢 实时行情：

视频展示：

其它相关内容：

☘️App（exe）：这个只展示当前价格实时变化。

☘️ 基金下载App (exe)：只支持基金哦

☘️ 股票历史数据下载：一支

☘️ 股票历史数据下载：20 支

1. Excel VBA 自动化与对象模型

编写VBA时先在编辑器的工具–选项，里面设置一下文本的字体、字号。excel默认的字体不太好。

原理与作用：

Excel VBA（Visual Basic for Applications）是 Office 应用内置的编程语言，通过 VBA 可以直接操作 Excel 的各个对象（如工作簿、工作表、单元格等），实现数据自动读取、写入和格式化。

关键技术点：

• 对象模型： 通过 ThisWorkbook、Worksheets、Range 等对象，可以定位到任意单元格，实现数据的读写操作。
• 动态定位： 利用字符串拼接和变量控制，实现根据不同行或区域自动更新数据，保证灵活性。

' 基础对象操作示例
Sub BasicObjectDemo()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' 写入数据到A1单元格
    ws.Range("A1").Value = "实时数据"
    
    ' 动态定位最后一行
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1
    ws.Cells(lastRow, 1).Value = Now() & " 数据更新"
End Sub

应用场景：
这种自动化技术适用于需要周期性更新数据的报表、仪表板以及需要与外部数据源交互的业务应用。

2. HTTP 请求与 API 数据获取

关键技术点：

• MSXML2.XMLHTTP 对象：
  • 用于构造和发送 HTTP 请求（通常是 GET 请求）。
  • 支持同步或异步调用，本文中采用同步方式，确保数据获取后再执行后续逻辑。
• 动态 URL 构造：
  • 利用股票代码、时间戳等参数构造 URL，确保每次请求的唯一性与时效性。
  • 时间戳的计算（从 1970 年开始的毫秒数）可以避免缓存问题，并确保数据新鲜。

' HTTP请求示例（需引用Microsoft XML库）
Sub GetAPIData()
    Dim http As New MSXML2.XMLHTTP60
    Dim url As String
    Dim timestamp As Long
    
    ' 生成13位时间戳（毫秒级）
    timestamp = DateDiff("s", "1/1/1970", Now()) * 1000
    
    ' 构造动态URL
    url = "https://api.example.com/data?symbol=600519&timestamp=" & timestamp
    
    ' 发送同步GET请求
    http.Open "GET", url, False
    http.setRequestHeader "Content-Type", "application/json"
    http.send
    
    If http.Status = 200 Then
        Debug.Print http.responseText
    Else
        MsgBox "请求失败：" & http.Status & " - " & http.statusText
    End If
End Sub

可以先用apipost等软件发送请求，看看api返回的数据的结构，再编写代码处理。

3. JSON 数据解析与字符串处理

现代 API 多以 JSON 格式传递数据，而 VBA 本身对 JSON 支持有限，因此需要借助外部库（如 VBA-JSON）进行解析。同时，返回的数据往往带有包装或格式不规范，必须进行预处理。

☘️VBA-JSON：https://github.com/VBA-tools/VBA-JSON

下载source code，解压，然后再VBA编辑器中，文件，导入，选择解压后的.bas文件即可。

然后，工具，引用，勾选微软脚本运行时这个选项：

关键技术点：

• 数据清洗：
  • 去除 API 返回结果中包裹 JSON 数据的函数调用（例如去掉 fortune_hq(...) 外壳）。
  • 将不符合标准的单引号替换为双引号，确保 JSON 格式正确。
• 字符串提取：
  • 利用自定义函数，通过查找特定键名及其对应的方括号，提取出数组子串。
  • 使用字符遍历和计数法（如括号匹配算法）来定位 JSON 数组的起始与结束位置。
• JSON 解析库：
  • 调用外部 JSON 库（如 VBA-JSON），将清洗后的字符串转换为 VBA 中的字典或集合对象，方便后续数据操作。

' JSON解析示例（需导入VBA-JSON模块）
Sub ParseJSONdata()
    Dim rawData As String
    Dim jsonStr As String
    Dim jsonDict As Dictionary
    
    ' 原始数据示例
    rawData = "fortune_hq({""data"":[[1633046400000,1850.0],[1633132800000,1862.5]]})"
    
    ' 数据清洗处理
    jsonStr = Mid(rawData, InStr(rawData, "{"), InStrRev(rawData, "}") - InStr(rawData, "{"))
    jsonStr = Replace(jsonStr, "'", """")  ' 单引号转双引号
    
    ' 使用JSON库解析
    Set jsonDict = JsonConverter.ParseJson(jsonStr)
    
    ' 提取数据数组
    Dim dataArray As Collection
    Set dataArray = jsonDict("data")
    
    ' 输出第一个数据点
    Debug.Print "时间戳：" & dataArray(1)(1)
    Debug.Print "价格：" & dataArray(1)(2)
End Sub

4. 自动任务调度与实时刷新

原理与作用：
实时数据监控系统需要定时刷新数据，Excel 提供了 Application.OnTime 方法用于任务调度，通过该方法可以在指定时间调用某个子程序，实现周期性操作。
关键技术点：

• OnTime 方法：
  • 可设定一个未来的时刻执行指定的 VBA 子程序，从而构成循环调用。
  • 每次调用后重新计算下一次运行时间，实现持续的数据刷新。
• 任务取消机制：
  • 提供停止自动刷新的方法，利用 OnTime 的取消参数，确保当用户需要停止刷新时能够安全退出任务调度。

使用OnTime时，代码要写在模块里面，而不是某个sheet里面。

Dim NextRunTime As Double

' 启动自动刷新（每60秒执行一次）
Sub StartAutoRefresh()
    NextRunTime = Now + TimeValue("00:01:00")
    Application.OnTime NextRunTime, "RefreshData"
End Sub

' 主刷新过程
Sub RefreshData()
    On Error GoTo ErrorHandler
    GetAPIData  ' 调用数据获取方法
    ParseJSONdata  ' 调用数据解析方法
    UpdateDashboard  ' 更新仪表板
Cleanup:
    StartAutoRefresh  ' 重新调度下一次任务
    Exit Sub
ErrorHandler:
    MsgBox "刷新失败：" & Err.Description
    Resume Cleanup
End Sub

' 停止自动刷新
Sub StopAutoRefresh()
    On Error Resume Next
    Application.OnTime NextRunTime, "RefreshData", , False
End Sub

5. 错误处理与健壮性设计

原理与作用：
任何数据抓取与处理过程都可能遇到异常情况（如网络故障、数据格式错误等），因此健全的错误处理机制至关重要。
关键技术点：

• On Error 语句：
  • 捕获运行时错误，防止程序因单个错误而中断。
  • 使用 On Error GoTo 跳转到错误处理代码，提供用户友好的错误提示，并记录错误信息以便后续调试。
• 错误回归与恢复：
  • 在关键步骤（如 JSON 解析）前后设置错误捕获，确保在失败时及时跳出当前操作区域，而不会影响整个任务的执行。

' 增强型错误处理示例
Sub SafeDataProcessing()
    On Error GoTo ErrorHandler
    
    ' 网络请求阶段
    Dim http As New MSXML2.XMLHTTP60
    http.Open "GET", "https://api.example.com/data", False
    http.send
    If http.Status <> 200 Then Err.Raise vbObjectError + 1, , "HTTP请求失败"
    
    ' 数据解析阶段
    On Error GoTo ParseError
    Dim jsonDict As Dictionary
    Set jsonDict = JsonConverter.ParseJson(http.responseText)
    
    ' 数据写入阶段
    On Error GoTo WriteError
    ThisWorkbook.Sheets("Data").Range("A1").Value = jsonDict("price")
    
    Exit Sub
    
ParseError:
    MsgBox "JSON解析错误：" & Err.Description, vbCritical
    Exit Sub
    
WriteError:
    MsgBox "数据写入失败：" & Err.Description, vbCritical
    Exit Sub
    
ErrorHandler:
    MsgBox "发生运行时错误：" & Err.Description, vbCritical
    Exit Sub
End Sub