如何通过VBA动态将API返回的JSON结果写入Excel工作表

针对你需要动态读取JSON结果的表头和数据、灵活写入Excel的需求，我们可以通过以下步骤实现，完全摆脱固定字段名和列数的限制：

核心思路 #

1. 从JSON返回的第一个数据对象中提取所有字段名作为表头
2. 根据数据行数和列数（字段数量）动态定义数组
3. 循环遍历每个JSON对象，动态读取对应字段的值填充数组
4. 将表头和数据一次性写入Excel区域

完整代码实现 #

Sub WriteDynamicJsonToExcel()
    Dim JsonResult As Object
    Dim firstItem As Dictionary
    Dim headers As Variant
    Dim dataArr As Variant
    Dim i As Long, j As Long
    Dim currentItem As Dictionary
    Dim headerKey As Variant
    
    ' 假设你已经完成了API调用和JSON解析，得到JsonResult对象
    Set JsonResult = ParseJson(ParseJson(req.responseText)("results")(1)("findings"))("results")
    
    ' 处理空结果的情况
    If JsonResult.Count = 0 Then
        MsgBox "没有数据可写入！"
        Exit Sub
    End If
    
    ' 1. 获取表头：从第一个数据对象中提取所有字段名
    Set firstItem = JsonResult(1)
    ReDim headers(1 To firstItem.Count)
    j = 1
    For Each headerKey In firstItem.Keys
        headers(j) = headerKey
        j = j + 1
    Next headerKey
    
    ' 2. 初始化数据数组：行数=数据条数，列数=字段数
    ReDim dataArr(1 To JsonResult.Count, 1 To firstItem.Count)
    
    ' 3. 填充数据到数组
    i = 1
    For Each currentItem In JsonResult
        j = 1
        For Each headerKey In firstItem.Keys
            dataArr(i, j) = currentItem(headerKey)
            j = j + 1
        Next headerKey
        i = i + 1
    Next currentItem
    
    ' 4. 写入Excel：先写表头，再写数据
    With Sheets("Sheet1")
        ' 写入表头到第一行
        .Range(.Cells(1, 1), .Cells(1, UBound(headers))).Value = headers
        ' 写入数据到表头下方的区域
        .Range(.Cells(2, 1), .Cells(JsonResult.Count + 1, UBound(headers))).Value = dataArr
    End With
    
    ' 释放对象
    Set JsonResult = Nothing
    Set firstItem = Nothing
    Set currentItem = Nothing
End Sub

代码关键部分解释 #

• 动态获取表头：通过firstItem.Keys遍历第一个JSON对象的所有键，这些就是我们需要的Excel表头，不管字段名和数量怎么变都能自动获取。
• 动态数组定义：用JsonResult.Count获取数据行数，firstItem.Count获取列数，再也不用手动写3这种固定数字了。
• 动态填充数据：循环每个JSON对象时，再次遍历表头的键，通过currentItem(headerKey)动态取值，完全不需要硬编码"company_code"这类字段名。
• 批量写入Excel：先把表头写入第一行，再把数据数组写入下方区域，比逐单元格写入效率高很多。

额外注意事项 #

• 如果API返回的JSON对象存在字段不一致的情况（比如有的对象多字段少字段），可以在循环时加判断：If currentItem.Exists(headerKey) Then ...来避免报错。
• 代码中使用的ParseJson需要引用Microsoft Scripting Runtime或者使用VBA-JSON库（你现有代码已经在使用，所以没问题）。

内容的提问来源于stack exchange，提问作者Renier Wessels