Question

我遇到了以下VBA代码，该代码非常适合我在Excel中创建一个函数，该函数在某个单元格中获取股票行情的Yahoo Finance股票报价。

该代码的唯一缺点是它为我提供了最后一个报价，而我也希望对股票价值具有类似的功能，例如7天前，1个月和6个月前。（即= today（）-7天或= today（）-30天。

有没有办法修改它，以便我可以创建所需的新功能，例如StockPrice1week，StockPrice6M等。

我不需要1周或6个月的价格范围，而只需要该日期的单个收盘价。我不是在寻找任何其他宏或替代方法，而只是在修改此VBA vode。

Function StockQuote(ticker As String)
    ' Get near real-time stock quote from Yahoo via JSON query

    Dim URL As String, response As String, stripped As String, inbits() As String, i As Long
    Dim request As WinHttp.WinHttpRequest                               ' needs Tools|References|WinHTTP Services
    On Error GoTo Err

    URL = "https://query2.finance.yahoo.com/v7/finance/quote?symbols=" & Trim(ticker)
    Set request = New WinHttp.WinHttpRequest
    With request
        .Open "GET", URL, True
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .Send
        .WaitForResponse
        response = .responseText
    End With

    If InStr(response, """result"":[]") <> 0 Then GoTo Err              ' ticker not found

    'kludge parse: strip JSON delimiters and quotes
    stripped = Replace(Replace(Replace(Replace(Replace(response, "[", ""), "]", ""), "{", ""), "}", ""), """", "")

    stripped = Replace(stripped, ":", ":,")                             ' keep colons for readability, but make them delimit
    inbits = split(stripped, ",")                                       ' split

    i = LBound(inbits)
    Do While inbits(i) <> "regularMarketPrice:" And i <= UBound(inbits) ' find "regularMarketPrice:" tag
        i = i + 1
    Loop

    If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then          ' not found; look for previous close
        i = LBound(inbits)
        Do While inbits(i) <> "regularMarketPreviousClose:" _
                                            And i <= UBound(inbits)
            i = i + 1
        Loop
        If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then GoTo Err
    End If

    StockQuote = Val(inbits(i + 1))                                     ' price is next element
    Exit Function

Err:
    StockQuote = CVErr(xlErrNA)

End Function

我相信ti可能与此片段有关，但不确定100％吗？！

Do While inbits(i) <> "regularMarketPrice:" And i <= UBound(inbits) ' find "regularMarketPrice:" tag
    i = i + 1
Loop

If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then          ' not found; look for previous close
    i = LBound(inbits)
    Do While inbits(i) <> "regularMarketPreviousClose:" _
                                        And i <= UBound(inbits)
        i = i + 1
    Loop
    If i > UBound(inbits) Or Not IsNumeric(inbits(i + 1)) Then GoTo Err
End If

感谢您的帮助！

创建Excel函数以获取Yahoo Finance股票报价

0 个答案: