如何使用VBA提取JSON嵌套数组中的data字段数据

问题原因 #

• 原有代码错误直接将二维结构的data数组赋值给单个单元格，Excel无法识别该写入方式
• 需要确保已提前配置VBA-JSON解析环境：先导入VBA-JSON模块，再在VBA编辑器的「工具」→「引用」中勾选Microsoft Scripting Runtime，否则ParseJson方法会直接报错

可用代码实现 #

Public Sub exceljson()
    Dim http As Object, JSON As Object, dataArr As Variant
    Dim i As Long, rowNum As Long
    
    ' 初始化HTTP请求对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://cdh.vnmha.gov.vn/KiWIS/KiWIS?service=kisters&type=queryServices&request=getTimeseriesValues&datasource=0&format=dajson&ts_id=96643010&period=P3D", False
    http.Send
    
    ' 异常判断：请求失败直接退出
    If http.Status <> 200 Then
        MsgBox "接口请求失败，错误码：" & http.Status
        Exit Sub
    End If
    
    ' 解析JSON，取data字段的二维数组
    Set JSON = ParseJson(http.responseText)
    Set dataArr = JSON(1)("data") ' JSON外层是数组，第一个元素包含data字段
    
    ' 写入表头
    Sheets(1).Cells(1, 1) = "Timestamp"
    Sheets(1).Cells(1, 2) = "Value"
    rowNum = 2 ' 从第二行开始写入数据
    
    ' 遍历二维数组写入两列数据
    For i = 1 To dataArr.Count
        Sheets(1).Cells(rowNum, 1) = dataArr(i)(1) ' 第一列为时间戳
        Sheets(1).Cells(rowNum, 2) = dataArr(i)(2) ' 第二列为对应数值
        rowNum = rowNum + 1
    Next
    
    MsgBox "数据提取完成，共写入" & dataArr.Count & "条记录"
End Sub

补充说明 #

如果不想额外安装VBA-JSON模块，也可以手动用字符串分割的方式提取data字段的内容，但是稳定性不如专用JSON解析库，更推荐优先用上述方案。

内容的提问来源于stack exchange，提问作者Tamotoji Doragon