使用 VBA 从集合的 JSON 集合创建数组

Question

我正在使用 API 调用导入 json 数据。一些数据（“列”和“值”）分别是集合和集合的集合。使用这些集合，然后我尝试创建一个数组，然后将该数组粘贴到 Excel 工作表中。我已成功使用以下代码将“列”数据粘贴到工作表中：

Dim ColumnArray as Variant

ColumnArray = CollectionToArray(sensorData_json("columns"))
ws31.Range("F8:I8").Value = ColumnArray

Public Function CollectionToArray(myCol As Collection) As Variant

    Dim result  As Variant
    Dim cnt     As Long

    ReDim result(myCol.Count)
    For cnt = 0 To myCol.Count - 1
        result(cnt) = myCol(cnt + 1)
    Next cnt
    CollectionToArray = result

End Function

但是，我在“价值”数据方面没有取得成功。我认为挑战在于“价值观”是导致我错误的集合的集合。我主要收到运行时错误“450”和运行时错误“13”错误。以下是 JSON 数据的示例：

{
    "project_pk": "xxxxxxx",
    "project_name": "ABCDE",
    "columns": ["A", "B", "C"],
    "values": [
        ["2020-02-05T00:00:00Z", 1.111, 2.222],
        ["2020-02-05T00:00:10Z", 3.333, 4.444],
        ["2020-02-05T00:00:20Z", 5.555, 6.666]...

更新代码：

Option Explicit

Sub GetSensorData()

    Dim objRequest As Object
    Dim strUrl As String
    Dim blnAsync As Boolean
    Dim strResponse As String
    Dim ws31 As Worksheet
    
    Set ws31 = Sheet31
    
    'clear previous information from sheet
    
    ws31.Range("B8:C9").ClearContents
    ws31.Range("B15:I10000").ClearContents
    
    Set objRequest = CreateObject("MSXML2.XMLHTTP")
    strUrl = "https://binni.azure-api.net/tunneling/project/" & ws31.[ProjectID5] & "/tbm/" & ws31.[TBMID5] & "/getTbmSensorData?tbmSensorIds=" & [TBMSensorsIDs] & "?fromDateTime=" & [fromDateTime] & "?toDateTime=" & [toDateTime]
        blnAsync = False

    With objRequest
        .Open "GET", strUrl, blnAsync
        .SetRequestHeader "Subscription-Key", ws31.[D2]
        .Send
    
    End With
    
    strResponse = objRequest.ResponseText

    Dim sensorData_json As Dictionary
    Set sensorData_json = JsonConverter.ParseJson(strResponse)
    
    'Get Project and TBM Name and place into worksheet
    
    ws31.Cells(8, 2) = sensorData_json("project_name")
    ws31.Cells(9, 2) = sensorData_json("tbm_name")
       
    'Get sensor information
        
    Dim JsonObject As Object, Arr

    Set JsonObject = JsonConverter.ParseJson(strResponse)
    
    Arr = GetArray(JsonObject)
    
    ws31.Range("A12").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
    
    
End Sub


Function GetArray(obj As Object)
    Dim Arr, headers, values, n As Long, i As Long, v
    
    Set headers = obj("columns")
    Set values = obj("values")
    'resize output array based on collection sizes
    ReDim Arr(1 To values.Count + 1)
    
    For n = 1 To headers.Count 'loop the headers
        Arr(1, n) = headers(n)
    Next n
    i = 2
    For Each v In values      'for each value collection
        For n = 1 To v.Count  '  loop the individual values
            Arr(i, n) = v(n)
        Next n
        i = i + 1
    Next v
    GetArray = Arr
End Function

Answer 1

假设您的数据代表一个常规表（每行中的项目数相同）：

Sub Test35()

    Dim JsonObject As Object, arr

    'loading from a cell for testing...
    Set JsonObject = JsonConverter.ParseJson(Sheet2.Range("A15").Value)
    
    arr = GetArray(JsonObject)
    
    Sheet2.Range("C17").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr

End Sub

Function GetArray(obj As Object)
    Dim arr, headers, values, n As Long, i As Long, v
    
    Set headers = obj("columns")
    Set values = obj("values")
    'resize output array based on collection sizes
    ReDim arr(1 To values.Count + 1, 1 To headers.Count)
    
    For n = 1 To headers.Count 'loop the headers
        arr(1, n) = headers(n)
    Next n
    i = 2
    For Each v In values      'for each value collection
        For n = 1 To v.Count  '  loop the individual values
            arr(i, n) = v(n)
        Next n
        i = i + 1
    Next v
    GetArray = arr
End Function