如何修改Excel转JSON的VBA代码，新增thresholdValues嵌套结构

完整修改后代码 #

Public Sub json_file()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim fs As Object
    Dim jsonfile
    Dim rangetoexport As Range ' 存储a-g字段（A-G列）
    Dim thresholdRng As Range ' 存储j-m字段（J-M列，对应嵌套对象）
    Dim restRng As Range ' 存储剩余n/y/z等字段
    Dim rowcounter As Long
    Dim columncounter As Long
    Dim linedata As String
    Dim lRow As Long

    ' 取有效行数
    lRow = Sheets(1).Range("A1").End(xlDown).Row

    ' 按结构需求划分数据区间，可根据实际表头位置调整列范围
    Set rangetoexport = Sheets(1).Range("A1:G" & lRow)
    Set thresholdRng = Sheets(1).Range("J1:M" & lRow)
    Set restRng = Sheets(1).Range("N1:Z" & lRow) ' 可根据实际最后一列调整

    Set fs = CreateObject("Scripting.FileSystemObject")
    ' 请修改为你本地实际存在的文件夹路径
    Set jsonfile = fs.CreateTextFile("C:\Users\你的用户名\Desktop\Files\jsondata.txt", True)

    ' 输出JSON数组开头
    jsonfile.WriteLine "["

    For rowcounter = 2 To rangetoexport.Rows.Count
        linedata = ""
        ' 1. 拼接a-g第一层字段
        For columncounter = 1 To rangetoexport.Columns.Count
            linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """:" & _
                        FormatJsonValue(rangetoexport.Cells(rowcounter, columncounter)) & ","
        Next
        linedata = Left(linedata, Len(linedata) - 1)

        ' 2. 拼接嵌套thresholdValues对象
        linedata = linedata & ",""thresholdValues"":{"
        For columncounter = 1 To thresholdRng.Columns.Count
            linedata = linedata & """" & thresholdRng.Cells(1, columncounter) & """:" & _
                        FormatJsonValue(thresholdRng.Cells(rowcounter, columncounter)) & ","
        Next
        linedata = Left(linedata, Len(linedata) - 1) & "}" ' 闭合嵌套对象

        ' 3. 拼接剩余第一层字段
        If restRng.Columns.Count > 0 Then
            linedata = linedata & ","
            For columncounter = 1 To restRng.Columns.Count
                ' 跳过空表头列
                If Trim(restRng.Cells(1, columncounter)) <> "" Then
                    linedata = linedata & """" & restRng.Cells(1, columncounter) & """:" & _
                                FormatJsonValue(restRng.Cells(rowcounter, columncounter)) & ","
                End If
            Next
            linedata = Left(linedata, Len(linedata) - 1)
        End If

        ' 拼接当前行对象，处理最后一行逗号
        If rowcounter = rangetoexport.Rows.Count Then
            linedata = "{" & linedata & "}"
        Else
            linedata = "{" & linedata & "},"
        End If
        jsonfile.WriteLine linedata
    Next

    ' 输出JSON数组结尾
    jsonfile.WriteLine "]"
    jsonfile.Close

    Set fs = Nothing
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "JSON生成完成"
End Sub

' 辅助函数：自动格式化JSON值，处理数据类型和引号
Private Function FormatJsonValue(val As Variant) As String
    Dim strVal As String
    strVal = Trim(CStr(val))
    
    ' 处理空值/null
    If strVal = "" Or LCase(strVal) = "null" Then
        FormatJsonValue = "null"
        Exit Function
    End If
    
    ' 处理布尔值
    If LCase(strVal) = "true" Or LCase(strVal) = "false" Then
        FormatJsonValue = LCase(strVal)
        Exit Function
    End If
    
    ' 处理数值（整数、小数都适配）
    If IsNumeric(val) Then
        FormatJsonValue = strVal
        Exit Function
    End If
    
    ' 字符串类型：加双引号，转义内容中的双引号
    FormatJsonValue = """" & Replace(strVal, """", "\""") & """"
End Function

关键调整说明 #

• 新增FormatJsonValue辅助函数，自动识别值类型：数值、布尔值、null不再添加多余双引号，字符串自动加双引号并转义内部的双引号，解决格式错误问题
• 按照需求重新划分了数据区间，将j到m列的字段单独封装为thresholdValues嵌套对象，符合预期的JSON结构
• 保留了原有的性能优化逻辑，大数据量转换时不会卡顿
• 可根据实际表头的列位置灵活调整三个range的列范围，适配不同的表格结构

注意：运行前请将代码中的文件路径修改为你本地实际存在的路径，否则会报错。

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