json - 尝试将 Excel 格式转换为 JSON

Question

我正在尝试将 excel 数据转换为以下 JSON 格式，但我的代码没有将其转换为准确的格式。您的帮助将不胜感激。
格式中有额外的 [ 如何使用 Excel VBA 实现这一点。
Excel 数据
ExcelData
必需的 JSON 格式
JSON Format
我的代码

    Public Function ToJSON(rng As Range) As String
    ' Make sure there are two columns in the range
    If rng.Columns.Count < 2 Then
        ToJSON = CVErr(xlErrNA)
        Exit Function
    End If
 
    Dim dataLoop, headerLoop As Long
    ' Get the first row of the range as a header range
    Dim headerRange As Range: Set headerRange = Range(rng.Rows(1).Address)
    
    ' We need to know how many columns are there
    Dim colCount As Long: colCount = headerRange.Columns.Count
    
    Dim json As String: json = "["
    
    For dataLoop = 1 To rng.Rows.Count
        ' Skip the first row as it's been used as a header
        If dataLoop > 1 Then
            ' Start data row
            Dim rowJson As String: rowJson = "{"
            
            ' Loop through each column and combine with the header
            For headerLoop = 1 To colCount
                rowJson = rowJson & """" & headerRange.Value2(1, headerLoop) & """" & ":"
                rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
                rowJson = rowJson & ","
            Next headerLoop
            
            ' Strip out the last comma
            rowJson = Left(rowJson, Len(rowJson) - 1)
            
            ' End data row
            json = json & rowJson & "},"
        End If
    Next
    
    ' Strip out the last comma
    json = Left(json, Len(json) - 1)
    
    json = json & "]"
    
    ToJSON = json
End Function

Answer 1

如果要以json结构的方式排列文本，可以使用vbTab和 vbLf :

Public Function ToJSON(rng As Range) As String
    ' Make sure there are two columns in the range
    If rng.Columns.Count < 2 Then
        ToJSON = CVErr(xlErrNA)
        Exit Function
    End If
 
    Dim dataLoop, headerLoop As Long
    ' Get the first row of the range as a header range
    Dim headerRange As Range: Set headerRange = rng.Rows(1).Cells
    
    ' We need to know how many columns are there
    Dim colCount As Long: colCount = headerRange.Columns.Count
    
    Dim json As String: json = "["
    
    For dataLoop = 1 To rng.Rows.Count
        ' Skip the first row as it's been used as a header
        If dataLoop > 1 Then
            ' Start data row
            Dim rowJson As String: rowJson = vbLf & vbTab & "{" & vbLf
            
            ' Loop through each column and combine with the header
            For headerLoop = 1 To colCount
                rowJson = rowJson & vbTab & vbTab & """" & headerRange.Value2(1, headerLoop) & """" & ":"
                rowJson = rowJson & """" & rng.Value2(dataLoop, headerLoop) & """"
                rowJson = rowJson & "," & vbLf
            Next headerLoop
            
            ' Strip out the last comma
            rowJson = Left(rowJson, Len(rowJson) - 2) & vbLf
            
            ' End data row
            json = json & rowJson & vbTab & "},"
        End If
    Next
    
    ' Strip out the last comma
    json = Left(json, Len(json) - 1)
    
    json = json & vbLf & "]"
    
    ToJSON = json
End Function

Sub test1()
    Debug.Print ToJSON(Range("A1").CurrentRegion)
End Sub

输出:

[
    {
        "name":"About the inspection",
        "questionText":"report name",
        "questionHelp":"some help 1",
        "sortOrder":"1",
        "isActive":"TRUE",
        "questionType":"TEXT",
        "options":""
    },
    {
        "name":"",
        "questionText":"surveyor",
        "questionHelp":"some help 2",
        "sortOrder":"2",
        "isActive":"TRUE",
        "questionType":"TEXT",
        "options":""
    }, 
... and so on