使用VBA JsonConverter将JSON转换为指定格式表格的问题

原始JSON数据 #

{"payload": {"c": {"aa": "value_aa","bb": "value_bb"},"k": {"aaa": "value_aaa","bbb": "value_bbb"},"o": {"oa": "hallo","odid": ["121","222"]}}}

期望的Excel输出格式 #

parameter   value
payload.c.aa    value_aa
payload.c.bb    value_bb
payload.k.aaa   value_aaa
payload.k.bbb   value_bbb
payload.o.oa    hallo
payload.o.odid1 121
payload.o.odid2 222

现有代码问题 #

当前编写的VBA代码生成结果不符合预期，缺少parameter列，值未显示在正确列，且未处理数组元素的键名拼接（如odid1、odid2），需要实现与键完全无关的通用转换逻辑。原代码如下：

Sub jsonListToExcel(jsonObject As Object, sheet As Worksheet, row As Long, col As Long)
    Dim i As Integer
    i = 1
    With sheet
        For Each element In jsonObject
            .Cells(row + i, col).Value = element
            i = i + 1
        Next element
    End With
End Sub

Sub jsonToExcel(jsonObject As Object, sheet As Worksheet, row As Long, col As Long, parentKey As String)
    For Each Key In jsonObject.Keys
        If TypeName(jsonObject(Key)) = "Dictionary" Then
            jsonToExcel jsonObject(Key), sheet, row, col, parentKey & "." & Key
        ElseIf TypeName(jsonObject(Key)) = "Collection" Then
            jsonListToExcel jsonObject(Key), sheet, row, col
        Else
            If Left(parentKey & "." & Key, 1) = "." Then
                sheet.Cells(row, col).Value = Right(parentKey & "." & Key, Len(parentKey & "." & Key) - 1)
            Else
                sheet.Cells(row, col).Value = parentKey & "." & Key
            End If
                
            sheet.Cells(row, col + 1).Value = jsonObject(Key)
            row = row + 1
        End If
    Next Key
End Sub
    
Sub Test1()
    Dim jsonText As String
    Dim jsonObject As Object
    
    Dim FSO As New FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    jsonText = "{""payload"":{""c"":{""aa"":""value_aa"",""bb"":""value_bb""},""k"":{""aaa"":""value_aaa"",""bbb"":""value_bbb""},""o"":{""oa"":""hallo"",""odid"":[""121"",""222""]}}}"
    
    Set jsonObject = JsonConverter.ParseJson(jsonText)
    
    jsonToExcel jsonObject, ActiveSheet, 1, 1, ""
End Sub

修正后的代码 #

' 处理数组（Collection）类型的JSON元素，拼接带索引的键名
Sub jsonListToExcel(jsonObject As Object, sheet As Worksheet, ByRef row As Long, col As Long, parentKey As String)
    Dim i As Integer
    i = 1
    With sheet
        For Each element In jsonObject
            ' 拼接数组元素的键名：父键+索引（从1开始）
            .Cells(row, col).Value = parentKey & i
            .Cells(row, col + 1).Value = element
            row = row + 1
            i = i + 1
        Next element
    End With
End Sub

' 递归处理JSON对象（Dictionary），通用转换逻辑
Sub jsonToExcel(jsonObject As Object, sheet As Worksheet, ByRef row As Long, col As Long, parentKey As String)
    Dim currentKey As String
    For Each currentKey In jsonObject.Keys
        Dim fullKey As String
        ' 拼接完整键名，避免开头出现多余的点
        If parentKey = "" Then
            fullKey = currentKey
        Else
            fullKey = parentKey & "." & currentKey
        End If
        
        Select Case TypeName(jsonObject(currentKey))
            Case "Dictionary"
                ' 递归处理嵌套对象
                jsonToExcel jsonObject(currentKey), sheet, row, col, fullKey
            Case "Collection"
                ' 处理数组，传递当前完整键名作为父键
                jsonListToExcel jsonObject(currentKey), sheet, row, col, fullKey
            Case Else
                ' 处理普通键值对
                sheet.Cells(row, col).Value = fullKey
                sheet.Cells(row, col + 1).Value = jsonObject(currentKey)
                row = row + 1
        End Select
    Next currentKey
End Sub

Sub Test1()
    Dim jsonText As String
    Dim jsonObject As Object
    Dim targetSheet As Worksheet
    Dim startRow As Long
    
    ' 初始化参数
    Set targetSheet = ActiveSheet
    startRow = 1
    
    ' 清空目标工作表内容（可选）
    targetSheet.Cells.Clear
    
    ' 设置表头
    targetSheet.Cells(startRow, 1).Value = "parameter"
    targetSheet.Cells(startRow, 2).Value = "value"
    startRow = startRow + 1 ' 表头占一行，从下一行开始写入数据
    
    ' JSON文本（可替换为读取文件逻辑）
    jsonText = "{""payload"":{""c"":{""aa"":""value_aa"",""bb"":""value_bb""},""k"":{""aaa"":""value_aaa"",""bbb"":""value_bbb""},""o"":{""oa"":""hallo"",""odid"":[""121"",""222""]}}}"
    
    ' 解析JSON
    Set jsonObject = JsonConverter.ParseJson(jsonText)
    
    ' 执行转换
    jsonToExcel jsonObject, targetSheet, startRow, 1, ""
    
    ' 自动调整列宽（可选）
    targetSheet.Columns("A:B").AutoFit
End Sub

关键修改点 #

1. 参数传递改为ByRef：将row参数改为按引用传递，确保递归调用时能正确更新行号，避免数据覆盖或漏写。
2. 数组元素键名拼接：处理Collection（JSON数组）时，传递父键并添加索引序号（如odid1、odid2），同时将值写入value列。
3. 键名拼接优化：修复开头多余点的问题，直接通过判断parentKey是否为空来拼接完整键名，逻辑更简洁。
4. 添加表头：在Test1中直接写入表头，确保输出符合预期格式。
5. 代码结构优化：使用Select Case替代If-ElseIf，增强代码可读性；添加可选的清空工作表和自动列宽调整逻辑。

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