Разбор нескольких ячеек и значений из одного JSON-запроса

Question

Я хотел бы отобразить следующие переменные из JSON-запроса; "time", "open", "high", "low", "close", "volumefrom", "volumeto" соответственно в следующих столбцах B, C, D, E, F, G и H.

Запрос: https://min-api.cryptocompare.com/data/histoday?fsym=BTC&tsym=USD&limit=60&aggregate=3&e=CCCAGG

Итак, я хотел бы увидеть, например, значения "open", расположенные в 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},

Может кто-нибудь объяснить мне, что я делаю не так? Заранее спасибо,

Answer 1

Может кто-нибудь объяснить мне, что я делаю не так?

Вы близки:

1. Я подозреваю, что вы, вероятно, сделали копирование / вставку в анализаторе JSON вместо загрузки *.bas файл и импортировать его. Если вы скопировали файл, а затем вставили его в модуль, вы увидите строку Attribute VB_Name = "JsonConverter" Хотя законно в .bas файл, он не находится в модуле, поэтому *"ошибка компиляции: недопустимо внутри процедуры." * сообщение об ошибке.
2. Вы создаете strURL прежде чем определить переменные, которые включены. Поэтому переменные будут пустыми
3. Когда вы пишете результаты, номера столбцов отключены, поэтому они начнутся в столбце A вместо B.
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 строка, видимая в основном файле, если вы откроете ее в текстовом редакторе, вы можете обратиться к статье Чипа Пирсона об атрибутах кода для обозревателя объектов VBA. Обычно считается плохой формой ссылаться на внешние ссылки, так как они могут исчезнуть. Тем не менее, я не смог найти хорошее обсуждение здесь на SO. Если я пропустил это, кто-то, пожалуйста, прокомментируйте, и я буду редактировать это.

Answer 2

Вы можете получить данные JSON в массивы и вывести их, как показано в примере кода ниже. Импортируйте модуль JSON.bas в проект VBA для обработки 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

Вот вывод для меня: