json - 打开网页，全选，复制到工作表

Question

希望从 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

另外，我如何从网页下拉列表“过期”中提取日期并将它们全部粘贴到 Excel 中？

我一直在寻找对我有用的东西，没有运气!

Answer 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 格式返回。导航页面 e. G。在 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

我的输出如下:



为了使输出更接近网页上的并排 View ，您可以稍微使用查询参数:

    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")

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



顺便说一句，应用了类似的方法 in other answers .