在现代金融分析中，实时数据的获取与展示是至关重要的一环。对于股票投资者、分析师以及数据科学家而言，能够迅速且准确地掌握市场动态，对于制定投资策略、进行风险评估具有重要意义。然而，传统的手工数据收集和更新方式不仅效率低下，而且容易出错。节前有同事问我能否运用VBA实现股票实时数据自动刷新和展示，通过不打开网页在Excel中就能集中查看股票数据，为了解决这个问题，我也查阅了相关资料，利用Excel VBA（Visual Basic for Applications）的强大功能，结合网络请求，实现了股票实时数据的自动刷新与展示。
股票实时数据
本文将介绍一个基于Excel VBA的自动化脚本，该脚本通过调用腾讯财经的API接口，定时获取指定股票代码的实时数据，并将这些数据自动填充到Excel表格中。脚本中包含了三个主要部分：自动刷新子程序用于设置定时任务，关闭自动刷新子程序用于停止定时任务，实时数据子程序则负责实际的数据获取与填充工作。
在自动刷新子程序中，通过Application.OnTime方法设置了一个每隔5秒执行一次的定时任务，该任务将调用实时数据子程序。实时数据子程序首先遍历Excel表格中的股票代码，根据股票代码的规则构建API请求URL，然后使用msxml2.xmlhttp对象发送GET请求，获取返回的JSON格式数据（尽管这里通过Split函数处理的是以~分隔的字符串，实际应为JSON解析，但为了简化示例，这里采用模拟处理）。最后，将解析得到的数据填充到对应的Excel单元格中，并在C1单元格显示当前的数据刷新次数。
关闭自动刷新子程序则通过调用Application.OnTime方法并设置其第四个参数为False来取消定时任务，同时在“实时数据”工作表的C1单元格显示“暂停中!”，以提示用户当前数据刷新已停止。
此脚本不仅提高了数据更新的效率，还减少了人为错误的可能性，为金融分析工作提供了极大的便利。通过简单的修改和调整，该脚本还可以扩展至其他类型的实时数据获取与展示，如外汇、期货等金融数据。
基金累计收益和超额收益率
部分代码如下：
' 定义全局变量Public n As Long, NewTime As Date' 自动刷新数据的子程序Sub 自动刷新() ' 设置下一次自动刷新的时间为当前时间加上5秒 NewTime = Now + TimeValue("00:00:05") ' 调用实时数据子程序 Call 实时数据 ' 使用Application.OnTime安排下一次自动刷新 Application.OnTime NewTime, "自动刷新"End Sub' 关闭自动刷新的子程序Sub 关闭自动刷新() On Error Resume Next ' 取消已经设置的自动刷新 Application.OnTime EarliestTime:=NewTime, Procedure:="自动刷新", Schedule:=False ' 在"实时数据"工作表的C1单元格显示"暂停中!" Sheets("实时数据").Range("C1").Value = "暂停中!" ' 重置n为0（如果需要的话） n = 0End Sub' 实时数据更新的子程序Sub 实时数据() On Error Resume Next Dim i As Long, j As Long, dm As String, url As String Dim xx() As String, yy() As String ' 选择"实时数据"工作表 Sheets("实时数据").Select ' 更新n的值 n = n + 1 ' 遍历工作表中的A列数据 For i = 3 To Sheets("实时数据").Cells(Rows.Count, "A").End(xlUp).Row dm = Cells(i, 1).Value ' 根据dm的值构建不同的URL If Val(dm) < 600000 Then url = "此处省略网址" & dm Else url = "此处省略网址" & dm End If If Val(dm) = 1 Then url = "此处省略网址" ' 使用MSXML2.XMLHTTP对象获取数据 With CreateObject("msxml2.xmlhttp") .Open "get", url, False .send xx = Split(.responseText, "~") If UBound(xx) > 1 Then ' 将获取到的数据填充到对应的单元格中 ' ...（此处省略了具体的赋值操作，因为它们在原代码中已经存在） End If End With Next i ' 遍历工作表中的A列数据以获取另一种类型的数据 For j = 3 To Sheets("实时数据").Cells(Rows.Count, "A").End(xlUp).Row dm = Cells(j, 1).Value ' 根据dm的值构建不同的URL ' ...（此处省略了与上面相同的URL构建逻辑） ' 使用MSXML2.XMLHTTP对象获取数据 With CreateObject("msxml2.xmlhttp") .Open "get", url, False .send yy = Split(.responseText, "~") If UBound(yy) > 1 Then ' 将获取到的数据填充到对应的单元格中 ' ...（此处省略了具体的赋值操作） End If End With Next j ' 在C1单元格显示已经执行的次数 Sheets("实时数据").Range("C1").Value = nEnd Sub代码实现结果：
