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é.