Analiza múltiples celdas y valores desde una sola solicitud JSON

excel vba

Question

Me gustaría mostrar las siguientes variables de una solicitud JSON; "time", "open", "high", "low", "close", "volumefrom", "volumeto" en respectivamente las siguientes columnas B, C, D, E, F, G y H.

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

Entonces, me gustaría ver, por ejemplo, los valores de "abierto" ubicados en C2: C51.

Escribí la siguiente macro:

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

Desafortunadamente, la macro no funciona ya que la depuración muestra que hay un error en la siguiente línea:

For Each Item In JSON("DATA")

Sin embargo, necesito referirme a ("Datos") ¿verdad?

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

¿Alguien puede explicarme lo que estoy haciendo mal? Gracias por adelantado,

Answer 1

Puede obtener datos JSON en matrices y resultados como se muestra en el código de ejemplo a continuación. Importe el módulo JSON.bas al proyecto VBA para el procesamiento JSON.

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

Aquí está la salida para mí:

Answer 2

¿Alguien puede explicarme lo que estoy haciendo mal?

Estás cerca:

1. Sospecho que probablemente haya copiado / pegado en el analizador JSON en lugar de descargar el archivo *.bas e importarlo. Si copió el archivo y luego lo pegó en un módulo, verá la línea Attribute VB_Name = "JsonConverter" Aunque es legal en el archivo .bas , no está en un módulo, de ahí el error de compilación * ": procedimiento interno no válido. " * mensaje de error.
2. Cree strURL antes de definir las variables que se incluyen. Por lo tanto, las variables estarán en blanco.
3. Sus números de columna están apagados cuando escribe los resultados, por lo que comenzará en la columna A en lugar de B.
4. No puede declarar algunas de sus variables.
5. Dado que JSON es un objeto de tipo diccionario, la clave distingue entre mayúsculas y minúsculas (a menos que usted lo declare de otra manera). Por lo tanto, DATA y Data son dos claves diferentes. Necesitas usar Data .

Aquí está su código con los cambios; y no olvides importar el archivo .bas y no copiar / pegar.

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

Nota : Con respecto a la línea de Attribute visible en el archivo bas si la abre en un editor de texto, puede consultar el artículo de Chip Pearson sobre Atributos de Código para el Explorador de Objetos VBA . En general, se considera una mala forma hacer referencia a un enlace externo, ya que pueden desaparecer. Sin embargo, no pude encontrar una buena discusión aquí sobre SO. Si me lo he perdido, alguien por favor comente y lo editaré.