如何使用VBA将动态JSON数组数据导出为Excel表格？

核心思路 #

• 解析JSON字符串为VBA可操作对象（优先使用VBA-JSON库，兼容性更强；也可使用系统自带的ScriptControl）
• 提取JSON对象中所有唯一键作为表格表头
• 遍历JSON数组，将每个对象的键值对应填入工作表对应行列

实现步骤与代码 #

1. 基于VBA-JSON库的方案（推荐） #

VBA-JSON是第三方开源库，需先导入到VBA工程中：打开VBA编辑器（Alt+F11），右键工程→导入文件，选择下载好的JsonConverter.bas文件

Sub ExportJsonToExcel()
    Dim jsonStr As String
    Dim jsonArr As Object
    Dim keyCol As Collection
    Dim i As Integer, j As Integer
    Dim currentItem As Object
    
    ' 替换为你的实际JSON字符串
    jsonStr = "[{""年月字段"":""2024-05"",""rdID"":1001,""Product Code"":""PROD001"",""Suffixes"":""A""},{""年月字段"":""2024-06"",""rdID"":1002,""Product Code"":""PROD002"",""Suffixes"":""B""}]"
    
    ' 解析JSON数组
    Set jsonArr = JsonConverter.ParseJson(jsonStr)
    Set keyCol = New Collection
    
    ' 提取所有唯一键作为表头（自动去重）
    On Error Resume Next
    For Each currentItem In jsonArr
        For Each key In currentItem
            keyCol.Add key, Key:=key
        Next key
    Next currentItem
    On Error GoTo 0
    
    ' 写入表头
    For j = 1 To keyCol.Count
        Cells(1, j).Value = keyCol(j)
    Next j
    
    ' 逐行写入数据
    For i = 1 To jsonArr.Count
        Set currentItem = jsonArr(i)
        For j = 1 To keyCol.Count
            Cells(i + 1, j).Value = currentItem(keyCol(j))
        Next j
    Next i
    
    ' 自动适配列宽
    Columns.AutoFit
End Sub

2. 无第三方库的替代方案（使用ScriptControl） #

注意：该方案在64位Excel中可能存在兼容性问题，仅作备选

Sub ExportJsonWithoutLibrary()
    Dim sc As Object
    Dim jsonStr As String
    Dim jsonArr As Object
    Dim keyCol As Collection
    Dim i As Integer, j As Integer
    Dim currentItem As Object
    
    jsonStr = "[{""年月字段"":""2024-05"",""rdID"":1001,""Product Code"":""PROD001"",""Suffixes"":""A""},{""年月字段"":""2024-06"",""rdID"":1002,""Product Code"":""PROD002"",""Suffixes"":""B""}]"
    
    ' 创建ScriptControl对象解析JSON
    Set sc = CreateObject("MSScriptControl.ScriptControl")
    sc.Language = "JScript"
    sc.AddCode "function parseJson(str) { return JSON.parse(str); }"
    Set jsonArr = sc.Run("parseJson", jsonStr)
    
    ' 提取表头
    Set keyCol = New Collection
    On Error Resume Next
    For Each currentItem In jsonArr
        For Each key In currentItem
            keyCol.Add key, Key:=key
        Next key
    Next currentItem
    On Error GoTo 0
    
    ' 写入表头
    For j = 1 To keyCol.Count
        Cells(1, j).Value = keyCol(j)
    Next j
    
    ' 写入数据（JScript数组索引从0开始）
    For i = 1 To jsonArr.length
        Set currentItem = jsonArr.item(i - 1)
        For j = 1 To keyCol.Count
            Cells(i + 1, j).Value = currentItem(keyCol(j))
        Next j
    Next i
    
    Columns.AutoFit
    Set sc = Nothing
End Sub

代码说明 #

• 动态适配结构：通过Collection自动提取所有键并去重，不管JSON对象新增或删除字段，都能自动生成对应表头
• 数据匹配：遍历每个JSON对象时，根据表头的键精准匹配对应值，确保数据对应无误

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