json - 打开网页,选择全部,复制到表格中



vba excel-vba (1)

提供链接的网页源HTML

https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23

它不包含必要的数据,它使用AJAX。 网站 https://www.barchart.com 提供了API。 响应以JSON格式返回。 例如在Chrome中导航页面,然后打开“ 开发人员工具” 窗口( F12 ),“ 网络” 选项卡,重新加载( F5 )页面并检查记录的XHR。 最相关的数据是URL返回的JSON字符串:

https://core-api.barchart.com/v1/options/chain?symbol=GOOG&fields=optionType%2CstrikePrice%2ClastPrice%2CpercentChange%2CbidPrice%2CaskPrice%2Cvolume%2CopenInterest&groupBy=strikePrice&meta=field.shortName%2Cfield.description%2Cfield.type&raw=1&expirationDate=2018-02-23

您可以使用以下VBA代码来检索上述信息。 JSON.bas 模块导入VBA项目以进行JSON处理。

Option Explicit

Sub Test48759011()

    Dim sUrl As String
    Dim sJSONString As String
    Dim vJSON As Variant
    Dim sState As String
    Dim aData()
    Dim aHeader()

    sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
        Join(Array( _
            "symbol=GOOG", _
            "fields=" & _
            Join(Array( _
                "optionType", _
                "strikePrice", _
                "lastPrice", _
                "percentChange", _
                "bidPrice", _
                "askPrice", _
                "volume", _
                "openInterest"), _
            "%2C"), _
            "groupBy=", _
            "meta=" & _
            Join(Array( _
                "field.shortName", _
                "field.description", _
                "field.type"), _
            "%2C"), _
            "raw=1", _
            "expirationDate=2018-02-23"), _
        "&")
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", sUrl, False
        .send
        sJSONString = .responseText
    End With
    JSON.Parse sJSONString, vJSON, sState
    vJSON = vJSON("data")
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

我的输出如下:

要使输出更接近网页上的“并排”视图,您可以稍微使用查询参数:

    sUrl = "https://core-api.barchart.com/v1/options/chain?" & _
        Join(Array( _
            "symbol=GOOG", _
            "fields=" & _
            Join(Array( _
                "optionType", _
                "strikePrice", _
                "lastPrice", _
                "percentChange", _
                "bidPrice", _
                "askPrice", _
                "volume", _
                "openInterest"), _
            "%2C"), _
            "groupBy=strikePrice", _
            "meta=", _
            "raw=0", _
            "expirationDate=2018-02-23"), _
        "&")

并且还改变了这条线

    Set vJSON = vJSON("data")

在这种情况下,输出如下:

BTW,类似的方法应用于以下答案: 1 和 11 。

我已经高低搜索了一些对我有用的东西,没有运气! 任何帮助将非常感谢! :)希望从Barcharts.com复制股票期权数据并粘贴到Excel工作表中。

这是我在的地方:

Sub CopyTables()

    Dim ie As Object
    Dim I As Long
    I = 0
    Set ie = CreateObject("InternetExplorer.Application")
    ie.navigate "https://www.barchart.com/stocks/quotes/GOOG/options?moneyness=allRows&view=sbs&expiration=2018-02-23"
    ie.Visible = True

    Do While ie.Busy And Not ie.readyState = 4
    DoEvents
    Loop

    DoEvents

  Set tables = ie.document.getElementsByTagName("table")
  SetDataFromWebTable tables, Range("B5")
  ie.Quit
End Sub

如果可能的话,我也希望从网页下拉列表“Expiration”中提取日期,并将它们全部粘贴到excel中。 非常感谢您提供任何帮助!





xmlhttprequest