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

如果可能的话，我很乐意从网页下拉列表中提取日期＆＃34;到期＆＃34;并将它们全部粘贴到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

我的输出如下：

要使输出更接近网页上的“并排”视图，您可能会略微使用查询参数：

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

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

顺便说一句，类似的方法适用于以下答案：1，2，3，4，5，6， 7，8，9，10和11。

打开网页，选择全部，复制到表格中

1 个答案: