Excel宏生成嵌套JSON求助：修正扁平化表格转JSON的VBA代码

核心实现思路 #

基于扁平化表格的层级路径（如user.info.address.city），通过字典递归构建嵌套结构，再将结构序列化为标准JSON。

修正后的VBA代码 #

' 可选择启用Microsoft Scripting Runtime，或用CreateObject替代
Sub GenerateNestedJSON()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rootDict As Object
    Dim currentDict As Object
    Dim pathParts() As String
    Dim i As Integer, j As Integer
    Dim pathStr As String, cellValue As Variant
    
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 替换为你的目标工作表名
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rootDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历表格构建嵌套字典
    For i = 2 To lastRow ' 假设第一行是表头
        pathStr = Trim(ws.Cells(i, "A").Value)
        cellValue = ws.Cells(i, "B").Value
        
        If pathStr <> "" Then
            pathParts = Split(pathStr, ".") ' 按点拆分层级路径
            Set currentDict = rootDict
            
            ' 逐层创建嵌套字典节点
            For j = 0 To UBound(pathParts) - 1
                If Not currentDict.Exists(pathParts(j)) Then
                    Set currentDict(pathParts(j)) = CreateObject("Scripting.Dictionary")
                End If
                Set currentDict = currentDict(pathParts(j))
            Next j
            
            ' 给最终层级节点赋值
            currentDict(pathParts(UBound(pathParts))) = cellValue
        End If
    Next i
    
    ' 输出JSON到C1单元格，也可改为写入文件
    ws.Cells(1, "C").Value = ConvertDictToJSON(rootDict)
End Sub

' 辅助函数：将字典转为标准JSON字符串
Function ConvertDictToJSON(obj As Variant) As String
    Dim jsonStr As String
    Dim key As Variant
    Dim isFirst As Boolean
    
    jsonStr = "{"
    isFirst = True
    
    If TypeName(obj) = "Dictionary" Then
        For Each key In obj.Keys
            If Not isFirst Then jsonStr = jsonStr & ", "
            jsonStr = jsonStr & """" & key & """: "
            
            Select Case TypeName(obj(key))
                Case "Dictionary"
                    jsonStr = jsonStr & ConvertDictToJSON(obj(key))
                Case "String"
                    jsonStr = jsonStr & """" & Replace(obj(key), """", "\""") & """"
                Case Else ' 数字、布尔值直接输出
                    jsonStr = jsonStr & obj(key)
            End Select
            isFirst = False
        Next key
    End If
    
    jsonStr = jsonStr & "}"
    ConvertDictToJSON = jsonStr
End Function

关键修正点说明 #

1. 层级路径解析：通过Split拆分路径字符串，递归创建嵌套字典，确保每个层级节点被正确初始化
2. JSON序列化逻辑：针对字符串、数字、嵌套字典做差异化处理，自动转义字符串中的双引号，避免格式错误
3. 空值过滤：遍历表格时跳过空路径行，防止生成无效的JSON节点

使用注意事项 #

• 表格需保持固定结构：A列为层级路径（如order.customer.phone），B列为对应更新值，第一行是表头
• 若需支持数组类型（如路径为items.0.name），需扩展代码逻辑，判断路径中的数字索引并创建数组结构

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