打开网页，全选，复制到表格中 [英] Open webpage, select all, copy into sheet

问题描述

我在高低处搜寻了一些对我有用的东西，没有运气！任何帮助将不胜感激！ :) 希望从Barcharts.com复制股票期权数据并将其粘贴到Excel工作表中.

I have searched high and low for something that will work for me on this, no luck! Any help would be so much appreciated! :) Looking to copy Stock options data from Barcharts.com and paste into excel sheet.

我在这里:

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中. 提前非常感谢您对此提供的任何帮助！

If possible, I would love to also extract the dates from the webpage dropdown "Expiration" and paste them all into excel as well. Thank you so much in advance for any help on this!

推荐答案

所提供的链接提供的网页源HTML

The webpage source HTML by the link provided

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字符串:

doesn't contain the necessary data, it uses AJAX. The website https://www.barchart.com has an API available. Response is returned in JSON format. Navigate the page e. g. in Chrome, then open Developer Tools window (F12), Network tab, reload (F5) the page and examine logged XHRs. Most relevant data is JSON string returned by the URL:

您可以使用下面的VBA代码检索信息，如上所述. 将 JSON.bas 模块导入VBA项目中以进行JSON处理.

You may use the below VBA code to retrieve info as described above. Import JSON.bas module into the VBA project for JSON processing.

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

对我来说输出如下:

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

To make output closer to Side-by-Side view on the webpage, you may slightly play with query parameters:

    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 that case the output is as follows:

顺便说一句，在以下答案中应用了类似的方法: 1 ， 3 ，4 ， 5 ， 7 ，8 ， 9 ， 10 和 11 .

BTW, the similar approach applied in the following answers: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11.

这篇关于打开网页，全选，复制到表格中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！