Analysiert mehrere Zellen und Werte aus einer einzelnen JSON-Anfrage



excel vba (2)

Sie können JSON-Daten in Arrays abrufen und wie im folgenden Beispielcode gezeigt ausgeben. Importieren JSON.bas Modul JSON.bas in das VBA-Projekt für die JSON-Verarbeitung.

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

Hier ist die Ausgabe für mich:

Ich möchte die folgenden Variablen aus einer JSON-Anfrage anzeigen. "time", "open", "high", "low", "close", "volumefrom", "volumeto" in den folgenden Spalten B, C, D, E, F, G und H.

Die Anfrage: https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG

So möchte ich zum Beispiel die Werte von "open" in C2: C51 sehen.

Ich habe folgendes Makro geschrieben:

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

Leider funktioniert das Makro nicht, da das Debuggen anzeigt, dass in der folgenden Zeile ein Fehler vorliegt:

For Each Item In JSON("DATA")

Ich muss jedoch auf ("Daten") verweisen, oder?

{"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},

Kann mir jemand erklären, was ich falsch mache? Danke im Voraus,


Answer #1

Kann mir jemand erklären, was ich falsch mache?

Du bist nah dran:

  1. Ich vermute, Sie haben wahrscheinlich den JSON-Parser kopiert / *.bas anstatt die *.bas Datei herunterzuladen und zu importieren. Wenn Sie die Datei kopiert und dann in ein Modul eingefügt haben, wird die Zeile Attribute VB_Name = "JsonConverter" Obwohl in der .bas Datei .bas , befindet sich die Datei nicht in einem Modul, daher der Kompilierungsfehler * ": Ungültige interne Prozedur. " * Fehlermeldung.
  2. Sie erstellen strURL bevor Sie die enthaltenen Variablen definieren. Daher sind die Variablen leer
  3. Ihre Spaltennummern sind deaktiviert, wenn Sie die Ergebnisse schreiben. Sie beginnen also in Spalte A statt in Spalte B.
  4. Sie können einige Ihrer Variablen nicht deklarieren.
  5. Da es sich bei JSON um ein Objekt vom Typ Dictionary handelt, wird bei dem Schlüssel zwischen Groß- und Kleinschreibung unterschieden (sofern Sie nichts anderes deklarieren). Daher sind DATA und Data zwei verschiedene Schlüssel. Sie müssen Data .

Hier ist Ihr Code mit den Änderungen; und vergessen Sie nicht, die .bas-Datei zu importieren und nicht zu kopieren / einfügen.

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

Hinweis : Bezüglich der Attribute , die in der Basisdatei angezeigt wird, wenn Sie sie in einem Texteditor öffnen, können Sie auf den Artikel von Chip Pearson über Code-Attribute für den VBA-Objektbrowser verweisen. Es wird im Allgemeinen als fehlerhaft angesehen, auf einen externen Link zu verweisen, da dieser möglicherweise verschwindet. Allerdings konnte ich hier auf SO keine gute Diskussion finden. Wenn ich es verpasst habe, kommentiere bitte jemand und ich werde es bearbeiten.





vba