एक JSON- अनुरोध से कई कोशिकाओं और मूल्यों को पार्स करें




excel vba (2)

आपको JSON डेटा एरे और आउटपुट में मिल सकता है जैसा कि नीचे दिए गए उदाहरण कोड में दिखाया गया है। JSON प्रसंस्करण के लिए VBA प्रोजेक्ट में JSON.bas मॉड्यूल आयात करें। 

Option Explicit

Sub OHLCdata()

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

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG", 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

यहाँ मेरे लिए उत्पादन है:

मैं JSON- अनुरोध से निम्नलिखित चर प्रदर्शित करना चाहूंगा; "टाइम", "ओपन", "हाई", "लो", "क्लोज़", "वॉल्यूमफ्रॉम", "वॉल्यूमेटो" क्रमशः निम्नलिखित कॉलम बी, सी, डी, ई, एफ, जी और एच।

अनुरोध: https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG

इसलिए, मैं उदाहरण के लिए C2: C51 में स्थित "ओपन" के मूल्यों को देखना चाहूंगा।

मैंने निम्नलिखित मैक्रो लिखा है: 

Sub OHLCdata()                                                            
Dim strURL As String                                                      
Dim strJSON As String                                                     
Dim strCurrency As String                                                 
Dim strLength As Integer                                                  
Dim i As Integer                                  
Dim http As Object                                                     

strURL = "https://min-api.cryptocompare.com/data/histoday?fsym=" & strTicker & "&tsym=" & strCurrency & "&limit=" & strLength & "&aggregate=3&e=CCCAGG" 
strTicker = Range("A2")
strCurrency = Range("A3")                                           
strLength = Range("A4")                                                   
Set http = CreateObject("MSXML2.XMLHTTP")                           
http.Open "GET", strURL, False                                      
http.Send                                                             
strJSON = http.responsetext                                               
Set JSON = JsonConverter.ParseJson(strJSON)                                 
i = 2                                                                     

For Each Item In JSON("DATA")
Sheets(1).Cells(i, 1).Value = Item("time")
Sheets(1).Cells(i, 2).Value = Item("open")
Sheets(1).Cells(i, 3).Value = Item("high")
Sheets(1).Cells(i, 4).Value = Item("low")
Sheets(1).Cells(i, 5).Value = Item("close")
Sheets(1).Cells(i, 6).Value = Item("volumefrom")
Sheets(1).Cells(i, 7).Value = Item("volumeto")                              
i = i + 1                                                                
Next                                                                      
End Sub

दुर्भाग्य से, मैक्रो डिबगिंग के रूप में काम नहीं करता है यह दर्शाता है कि निम्न पंक्ति में कोई त्रुटि है: 

For Each Item In JSON("DATA")

हालांकि, मुझे ("डेटा") को संदर्भित करने की आवश्यकता है? 

{"Response":"Success","Type":100,"Aggregated":true,**"Data"**:[{"time":1493769600,"close":1507.77,"high":1609.84,"low":1424.05,"open":1445.93,"volumefrom":338807.89999999997,"volumeto":523652428.9200001},

क्या कोई मुझे समझा सकता है कि मैं क्या गलत कर रहा हूं? अग्रिम में धन्यवाद,

क्या कोई मुझे समझा सकता है कि मैं क्या गलत कर रहा हूं?

आप पास में हैं:

  1. मुझे संदेह है कि आपने संभवतः *.bas फ़ाइल को डाउनलोड करने और आयात करने के बजाय JSON पार्सर पर कॉपी / पेस्ट किया था। यदि आपने फ़ाइल को कॉपी किया है और फिर उसे किसी मॉड्यूल में पेस्ट किया है, तो आप लाइन को देखेंगे। Attribute VB_Name = "JsonConverter" लाइन को Attribute VB_Name = "JsonConverter" हालांकि .bas फ़ाइल में कानूनी है, यह किसी मॉड्यूल में नहीं है, इसलिए * "त्रुटि संकलन त्रुटि" प्रक्रिया के अंदर अमान्य है। " * त्रुटि संदेश।
  2. आप चर शामिल करने से पहले परिभाषित करते हैं। इसलिए चर रिक्त होंगे
  3. जब आप परिणाम लिखते हैं तो आपके कॉलम नंबर बंद होते हैं, इसलिए यह B के बजाय कॉलम A में शुरू होगा।
  4. आप अपने कुछ चर घोषित करने में विफल रहते हैं।
  5. चूँकि JSON एक डिक्शनरी टाइप ऑब्जेक्ट है, कुंजी केस सेंसिटिव होगी (जब तक कि आप इसे अन्यथा घोषित नहीं करते)। इसलिए DATA और Data दो अलग-अलग कुंजी हैं। आपको Data का उपयोग करने की आवश्यकता है।

परिवर्तनों के साथ यहां आपका कोड है; और .bas फ़ाइल आयात करना न भूलें और कॉपी / पेस्ट न करें। 

Option Explicit
Sub OHLCdata()
Dim strURL As String
Dim strJSON As String
Dim strCurrency As String
Dim strLength As Integer
Dim strTicker As String
Dim i As Integer
Dim http As Object

Dim JSON As Dictionary, Item As Dictionary


strTicker = Range("A2")
strCurrency = Range("A3")
strLength = Range("A4")

strURL = "https://min-api.cryptocompare.com/data/histoday?fsym=" & strTicker & "&tsym=" & strCurrency & "&limit=" & strLength & "&aggregate=3&e=CCCAGG"

Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.Send
strJSON = http.responsetext
Set JSON = JsonConverter.ParseJson(strJSON)
i = 2

For Each Item In JSON("Data")
Sheets(1).Cells(i, 2).Value = Item("time")
Sheets(1).Cells(i, 3).Value = Item("open")
Sheets(1).Cells(i, 4).Value = Item("high")
Sheets(1).Cells(i, 5).Value = Item("low")
Sheets(1).Cells(i, 6).Value = Item("close")
Sheets(1).Cells(i, 7).Value = Item("volumefrom")
Sheets(1).Cells(i, 8).Value = Item("volumeto")
i = i + 1
Next
End Sub

नोट : बेस फाइल में दिखाई देने वाली Attribute लाइन के संबंध में यदि आप इसे टेक्स्ट एडिटर में खोलते हैं, तो आप वीपीए ऑब्जेक्ट ब्राउज़र के लिए कोड एट्रीब्यूट्स पर चिप पियर्सन के लेख को संदर्भित कर सकते हैं। यह आमतौर पर बाहरी लिंक को संदर्भित करने के लिए खराब रूप माना जाता है, क्योंकि वे गायब हो सकते हैं। हालाँकि, मुझे SO पर यहाँ एक अच्छी चर्चा नहीं मिली। अगर मैं इसे याद कर रहा हूं, तो कृपया टिप्पणी करें और मैं इसे संपादित करूंगा।




json   excel   vba  


vba