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

Question

我正在使用API调用导入json数据。一些数据("列"one_answers"值"(分别是集合和集合的集合。使用这些集合，我试图创建一个数组，然后将数组粘贴到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