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 पर एपीआई उपलब्ध है। प्रतिक्रिया JSON प्रारूप में दी गई है। पृष्ठ को Chrome में नेविगेट करें, फिर डेवलपर टूल विंडो ( F12 ), नेटवर्क टैब, पृष्ठ को फिर से लोड करें ( F5 ) खोलें और लॉग किए गए XHRs की जाँच करें। सबसे अधिक प्रासंगिक डेटा JSON स्ट्रिंग URL द्वारा लौटाया गया है:

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 प्रसंस्करण के लिए VBA प्रोजेक्ट में JSON.bas मॉड्यूल आयात करें।

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 ।

मैंने किसी ऐसी चीज के लिए उच्च और निम्न खोज की है जो इस पर मेरे लिए काम करेगी, कोई भाग्य नहीं! किसी भी मदद की बहुत सराहना की जाएगी! :) Barcharts.com से स्टॉक ऑप्शंस डेटा कॉपी करना और एक्सेल शीट में पेस्ट करना।

यहाँ मैं कहाँ हूँ:

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

यदि संभव हो तो, मैं वेबपेज ड्रॉपडाउन "एक्सपायरी" से तारीखें निकालना और उन सभी को एक्सेल में भी पेस्ट करना पसंद करूंगा। इस पर किसी भी मदद के लिए अग्रिम में बहुत बहुत धन्यवाद!





xmlhttprequest