【VBA】excel获取股票实时行情(历史数据,基金数据下载)
文章目录
- 0. 效果展示与获取
- 其它相关内容:
- 1. Excel VBA 自动化与对象模型
- 2. HTTP 请求与 API 数据获取
- 3. JSON 数据解析与字符串处理
- 4. 自动任务调度与实时刷新
- 5. 错误处理与健壮性设计
0. 效果展示与获取
作品:https://mbd.pub/o/bread/aJaUmplq
需要定制可以联系我:不过不便宜。
🟢 实时行情:
视频展示:
excel 股票实时行情
其它相关内容:
☘️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×tamp=" & 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 格式正确。
- 去除 API 返回结果中包裹 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