如何通过Excel VBA将API返回的字典格式数据写入Excel表格？

以下代码基于你提供的现有API调用逻辑，针对不同常见字典结构给出实现方案，可根据你的实际数据结构调整：

场景1：API返回JSON数组（对应VBA Collection，每个元素为Dictionary） #

这是最常见的列表型数据结构，比如返回多条用户/订单数据。

示例字典结构（模拟） #

' JsonConverter返回的response为Collection，每个元素是包含字段的Dictionary
' 每个子字典包含：ID, Name, Email, Department 等键

目标表格格式 #

补充代码 #

替换原有注释区域的代码：

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'VBA Code need to be added here to Access data  from dictionary format into Excel table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") ' 替换为你的目标工作表名

Dim targetRow As Long, targetCol As Integer
Dim headerWritten As Boolean
Dim dataItem As Object, key As Variant

' 清空工作表原有数据（可选，按需保留）
ws.Cells.Clear

targetRow = 1

' 遍历Collection中的每个数据项
For Each dataItem In response
    ' 第一次循环写入表头
    If Not headerWritten Then
        targetCol = 1
        For Each key In dataItem.Keys
            ws.Cells(targetRow, targetCol).Value = key
            targetCol = targetCol + 1
        Next key
        targetRow = targetRow + 1
        headerWritten = True
    End If
    
    ' 写入当前数据行
    targetCol = 1
    For Each key In dataItem.Keys
        ws.Cells(targetRow, targetCol).Value = dataItem(key)
        targetCol = targetCol + 1
    Next key
    targetRow = targetRow + 1
Next dataItem

' 可选：将数据转为Excel正式表格（方便筛选、格式化）
ws.ListObjects.Add(xlSrcRange, ws.UsedRange, , xlYes).Name = "APIDataTable"

场景2：API返回单个JSON对象（对应VBA Dictionary，包含嵌套结构） #

比如返回单条详情数据，包含嵌套的子字典或集合。

示例字典结构（模拟） #

' JsonConverter返回的response为单个Dictionary，包含嵌套数据
Set response = New Dictionary
response.Add "Company", "XX科技"
response.Add "Address", New Dictionary
response("Address").Add "Street", "XX路123号"
response("Address").Add "City", "上海"
response.Add "Employees", New Collection ' 嵌套员工列表集合

补充代码 #

替换原有注释区域的代码：

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'VBA Code need to be added here to Access data  from dictionary format into Excel table
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Cells.Clear

Dim targetRow As Long, key As Variant
targetRow = 1

' 遍历顶级字典
For Each key In response.Keys
    If Not IsObject(response(key)) Then
        ' 普通键值对直接写入
        ws.Cells(targetRow, 1).Value = key
        ws.Cells(targetRow, 2).Value = response(key)
        targetRow = targetRow + 1
    Else
        ' 处理嵌套字典
        If TypeName(response(key)) = "Dictionary" Then
            ws.Cells(targetRow, 1).Value = key & "（嵌套数据）"
            targetRow = targetRow + 1
            Dim nestedKey As Variant
            For Each nestedKey In response(key).Keys
                ws.Cells(targetRow, 1).Value = "  - " & nestedKey
                ws.Cells(targetRow, 2).Value = response(key)(nestedKey)
                targetRow = targetRow + 1
            Next nestedKey
        ' 处理嵌套集合
        ElseIf TypeName(response(key)) = "Collection" Then
            ws.Cells(targetRow, 1).Value = key & "（列表数据）"
            targetRow = targetRow + 1
            Dim colItem As Object, headerWritten As Boolean, colCol As Integer
            headerWritten = False
            For Each colItem In response(key)
                If Not headerWritten Then
                    colCol = 2
                    For Each nestedKey In colItem.Keys
                        ws.Cells(targetRow, colCol).Value = nestedKey
                        colCol = colCol + 1
                    Next nestedKey
                    targetRow = targetRow + 1
                    headerWritten = True
                End If
                colCol = 2
                For Each nestedKey In colItem.Keys
                    ws.Cells(targetRow, colCol).Value = colItem(nestedKey)
                    colCol = colCol + 1
                Next nestedKey
                targetRow = targetRow + 1
            Next colItem
        End If
    End If
Next key

关键说明 #

1. 所有代码需确保你已引用Microsoft Scripting Runtime（用于Dictionary/Collection类型）
2. 请根据实际字典的键名、嵌套结构调整遍历逻辑
3. 若数据量较大，可关闭Excel屏幕更新提升效率：Application.ScreenUpdating = False，代码结束后再恢复：Application.ScreenUpdating = True

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