You need to enable JavaScript to run this app.
最新活动
大模型
产品
解决方案
定价
生态与合作
支持与服务
开发者
了解我们

Excel VBA优化及Yahoo Finance日期转Unix时间戳问题求助

问题1:优化UDF避免重复加载JSON数据

你的思路完全正确——用Static变量缓存数据就能解决重复请求的问题。这里我们可以用一个静态字典来存储不同股票的历史数据,键是股票代码,值是解析后的JSON对象。这样同一股票的多次调用只会请求一次API,后续直接从缓存读取。

修改后的代码:

Function YahooHigh(sTicker As String, sDate As String, idx As Integer)
    Static jsonCache As Object ' 静态字典,跨函数调用保留数据
    Dim json As Object
    
    ' 初始化缓存字典(仅第一次调用时执行)
    If jsonCache Is Nothing Then
        Set jsonCache = CreateObject("Scripting.Dictionary")
    End If
    
    ' 检查当前股票是否已缓存
    If Not jsonCache.Exists(sTicker) Then
        ' 未缓存则发起API请求
        With CreateObject("WinHttp.WinHttpRequest.5.1")
            .Open "GET", "https://www.alphavantage.co/query?function=TIME_SERIES_DAILY&symbol=" & sTicker & "&outputsize=full&apikey=myapikey"
            .Send
            ' 解析JSON并存入缓存
            Set json = JsonConverter.ParseJson(.responseText)
            Set jsonCache(sTicker) = json
        End With
    Else
        ' 从缓存中取出已有的JSON数据
        Set json = jsonCache(sTicker)
    End If
    
    ' 返回指定类型的数据(添加错误处理避免日期不存在的报错)
    On Error Resume Next
    Select Case idx
        Case 1: YahooHigh = json("Time Series (Daily)")(sDate)("2. high")
        Case 2: YahooHigh = json("Time Series (Daily)")(sDate)("4. close")
        Case Else: YahooHigh = Empty
    End Select
    On Error GoTo 0
End Function

关键说明:

  • Static jsonCache:这个变量会在函数多次调用间保留值,不会每次调用都重新初始化。
  • 字典缓存:按股票代码区分数据,不同股票的请求会分开缓存,互不干扰。
  • 错误处理:添加On Error Resume Next避免因指定日期不存在导致的函数报错。

问题2:Yahoo Finance动态链接无法获取数据

这个问题主要有两个原因:Unix时间戳的时区问题Yahoo的反爬拦截,下面逐一解决:

原因1:时间戳时区不匹配

你的ToUnix函数是基于本地时间计算的,但Yahoo Finance的period1/period2需要的是UTC时间戳。如果本地时区不是UTC,会导致日期匹配错误。

原因2:反爬拦截

Yahoo现在会拦截非浏览器的请求,直接用MSXML2.ServerXMLHTTP请求会返回验证页面,而非历史数据。需要添加模拟浏览器的请求头。

修正后的完整代码:

Sub MyTest()
    Dim html As Object, ele As Object
    Dim sTicker As String
    Dim period1 As Long, period2 As Long
    Dim url As String
    
    ' 读取工作表参数
    sTicker = Sheets(1).Range("B1").Value ' 比如GOOG
    period1 = ToUnixUTC(Sheets(1).Range("B2").Value) ' 起始日期转UTC时间戳
    period2 = ToUnixUTC(Sheets(1).Range("B3").Value) ' 结束日期转UTC时间戳
    
    ' 构造请求链接
    url = "https://finance.yahoo.com/quote/" & sTicker & "/history?period1=" & period1 & "&period2=" & period2 & "&interval=1d&filter=history&frequency=1d"
    
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", url, False
        ' 添加浏览器请求头,避免被反爬拦截
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
        .setRequestHeader "Accept-Language", "en-US,en;q=0.9"
        .Send
        
        ' 检查请求状态
        If .Status <> 200 Then
            MsgBox "请求失败" & vbNewLine & .Status & " - " & .StatusText
            Exit Sub
        End If
        
        ' 解析HTML
        Set html = CreateObject("htmlfile")
        html.body.innerHTML = .responseText
        
        ' 注意:Yahoo的表格类名可能会更新,需根据当前页面结构调整
        ' 查找历史数据表格(当前类名示例,若失效需检查页面源码)
        Set ele = html.querySelector("table.yf-ewueuo")
        If ele Is Nothing Then
            MsgBox "未找到历史数据表格,页面结构可能已更新"
            Exit Sub
        End If
        
        ' 读取第二行数据(第一行是表头)
        Dim tCell As Object, cnt As Long
        cnt = 0
        For Each tCell In ele.getElementsByTagName("tr")(1).Children
            cnt = cnt + 1
            Select Case cnt
                Case 3: Debug.Print "High: " & tCell.innerText
                Case 5: Debug.Print "Close: " & tCell.innerText
            End Select
        Next tCell
    End With
End Sub

' 转换日期为UTC时间戳
Public Function ToUnixUTC(dt As Date) As Long
    Dim utcDt As Date
    ' 计算本地时间与UTC的偏移(考虑夏令时)
    utcDt = dt - TimeZoneOffset(dt)
    ToUnixUTC = DateDiff("s", #1/1/1970#, utcDt)
End Function

' 获取本地时区与UTC的偏移小时数(含夏令时)
Private Function TimeZoneOffset(dt As Date) As Double
    Dim tzi As TIME_ZONE_INFORMATION
    Dim result As Long
    result = GetTimeZoneInformation(tzi)
    
    ' 计算总偏移(分钟转小时)
    Dim totalBias As Long
    totalBias = tzi.Bias
    If result = 2 Then ' 夏令时生效
        totalBias = totalBias + tzi.DaylightBias
    End If
    TimeZoneOffset = totalBias / -60 ' 转换为小时(Bias是UTC相对于本地的偏移,取反得到本地相对于UTC的偏移)
End Function

' Windows API声明(用于获取时区信息)
Private Declare PtrSafe Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(0 To 31) As Integer
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(0 To 31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

关键说明:

  1. UTC时间戳转换:通过API获取时区偏移,将本地日期转换为UTC时间戳,确保和Yahoo的参数要求匹配。
  2. 请求头模拟:添加User-Agent等头信息,让请求看起来像浏览器发起的,避免被拦截。
  3. 表格选择优化:用querySelector按类名查找表格,比getElementsByTagName更可靠,但要注意Yahoo的类名可能会更新,若失效需查看页面源码调整。

内容的提问来源于stack exchange,提问作者YasserKhalil

火山引擎 最新活动