“将 VBA 脚本从 Excel 转换为 JSON：处理多余的逗号”

Question

“即使经过多次尝试，我也一直在努力消除 JSON 输出中的尾随逗号。有什么建议吗？

我尝试过调整这个特定部分，但我似乎无法做到正确：

vba 复制代码 ' 将构建的行 JSON 写入文件 如果CRow < TRow Then Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "}," Else ' Print the JSON without the trailing comma for the last row Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "}" End If

Here is the script that I am using....

     Private Sub CommandButton1_Click()
        ' Declare variables
        Dim TRow As Long, CRow As Long, CCol As Long, TCol As Long
        Dim Ws As Worksheet, txt As String, yesNo As String
        Dim fileSaveName As String, fileNumber As Integer
        
        ' Set reference to the worksheet named "Paste to TEMPLATE"
        Set Ws = Sheets("Paste to TEMPLATE")
        
        ' Get the total number of columns and rows in the worksheet
        TCol = Ws.Cells.CurrentRegion.Columns.Count
        TRow = Ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
        
        ' Open a file save dialog to get the path and name for the JSON file
        fileSaveName = Application.GetSaveAsFilename(fileFilter:="JSON Files (*.json), *.json")
        
        ' Check if a file name was chosen
        If fileSaveName <> "False" Then
            
            ' Open the file for writing
            fileNumber = FreeFile
            Open fileSaveName For Output As fileNumber
            
            ' Write the beginning of the JSON structure
            Print #fileNumber, "{" & VBA.vbCrLf & VBA.vbTab & VBA.Chr(34) & "systemId" & VBA.Chr(34) & ": 12," & VBA.vbCrLf & VBA.vbTab & VBA.Chr(34) & "prismIntakes" & VBA.Chr(34) & ": [" & VBA.vbTab
            
            ' Loop through each row in the worksheet
            For CRow = 2 To TRow
                
                ' Check if the first column of the row is not empty
                If VBA.Trim(Ws.Cells(CRow, 1).Value) <> "" Then
                    
                    ' Initialize text variable
                    Print #fileNumber, VBA.vbTab & VBA.vbTab & "{" '& VBA.vbCrLf
                    txt = ""
                    
                    ' Loop through each column in the row
                    For CCol = 1 To TCol
                        
                        ' Check specific columns for special handling
                        If CCol = 1 Or CCol = 3 Or CCol = 4 Or CCol = 5 Or CCol = 12 Or CCol = 13 Or CCol = 17 Then
                            
                            
                            If CCol = 12 Then
                                
                                ' Construct JSON for jobComments
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & "jobComments" & VBA.Chr(34) & ":" & "[" & VBA.vbCrLf & _
                                VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & "{" & VBA.vbCrLf & VBA.vbTab
                                
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & VBA.Replace(Ws.Cells(CRow, CCol).Value, VBA.Chr(10), " ") & VBA.Chr(34) & VBA.vbCrLf
                                
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & "}" & VBA.vbCrLf & VBA.vbTab & VBA.vbTab & VBA.vbTab & "]," & VBA.vbCrLf
                            
                            ElseIf CCol = 13 Then
                                
                                ' Construct JSON for jobAddress
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & "jobAddress" & VBA.Chr(34) & ":" & "{" & VBA.vbCrLf
                                
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 1).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 1).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 2).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 2).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 3).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 3).Value & VBA.Chr(34) & VBA.vbCrLf
        
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & "}," & VBA.vbCrLf
                                
                            ElseIf CCol = 17 Then
                                
                                ' Construct JSON for jobContacts
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & "jobContacts" & VBA.Chr(34) & ":" & "[" & VBA.vbCrLf & _
                                VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & "{" & VBA.vbCrLf & VBA.vbTab
                                
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 2).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 2).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 3).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 3).Value & VBA.Chr(34) & "," & VBA.vbCrLf & _
                                    VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 4).Value & VBA.Chr(34) & ":"
                                    
                                    If VBA.LCase(Ws.Cells(CRow, CCol + 4).Value) = "no" Then
                                        yesNo = " false,"
                                    Else
                                        yesNo = " true,"
                                    End If
                                    
                                    txt = txt & yesNo & VBA.vbCrLf
                                    
                                    '*********** phoneInfo ***********
                                    
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & "phoneInfo" & VBA.Chr(34) & ":" & "{" & VBA.vbCrLf
                                
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol + 5).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol + 5).Value & VBA.Chr(34) & VBA.vbCrLf
        
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & "}" & VBA.vbCrLf
                                
                                    '*********************************
                                    
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.vbTab & "}" & VBA.vbCrLf & VBA.vbTab & VBA.vbTab & VBA.vbTab & "]" & VBA.vbCrLf
                            
        
                            ElseIf CCol = 22 Then
                                
                                ' Construct JSON for a regular column
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol).Value & VBA.Chr(34) & VBA.vbCrLf
                                
                            Else
                                
                                ' Construct JSON for a regular column
                                txt = txt & VBA.vbTab & VBA.vbTab & VBA.vbTab & VBA.Chr(34) & Ws.Cells(1, CCol).Value & VBA.Chr(34) & ":" & _
                                    VBA.Chr(34) & Ws.Cells(CRow, CCol).Value & VBA.Chr(34) & "," & VBA.vbCrLf
                            End If
                            
                            
                        End If
                        
                    Next CCol
                    
                     ' Write the constructed JSON for the row to the file
                    If CRow < TRow Then
                        Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "},"
                    Else
                        Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "}"
                    End If
                    
                End If
                
            Next CRow
            
            ' Write the end of the JSON structure
            Print #fileNumber, VBA.vbTab & "]" & VBA.vbCrLf & "}"
        
            ' Close the file
            Close fileNumber
             
        End If
    End Sub
    
    
    'Summary:
    
    'Sub CommandButton1_Click(): This defines the start of a subroutine that will be executed when CommandButton1 is clicked.
    
    'Variable Declarations:
    
    'TRow, CRow, CCol, TCol: These are variables to hold row and column numbers.
    'Ws: This is a worksheet object.
    'txt, yesNo: These are string variables.
    'fileSaveName, fileNumber: These variables are for saving the file.
    'Worksheet Initialization:
    
    'Set Ws = Sheets("Paste to TEMPLATE"): This sets the variable Ws to reference the worksheet named "Paste to TEMPLATE".
    'File Save Dialog:
    
    'fileSaveName = Application.GetSaveAsFilename(...): This opens a dialog box for the user to specify the file name and path to save the JSON file.
    'File Writing:
    
    'The code checks if a file name was chosen (If fileSaveName <> "False" Then) and proceeds to open the file and write JSON data into it.
    'The loop (For CRow = 2 To TRow) iterates through each row starting from the second row.
    'It checks if the first column of the row is not empty (If VBA.Trim(Ws.Cells(CRow, 1).Value) <> "") and proceeds to construct JSON data from the row's cell values.
    
    'JSON Construction:
    
    'The JSON structure is constructed with specific formatting for different cell values.
    'Conditions are used to handle specific columns differently (If CCol = 1 Or CCol = 3 Or ...).
    'The constructed JSON data is written to the file.
    
    'Loop End and File Closure:
    
    'Once all rows are processed, the loop ends, and the JSON file is properly closed.

 [Headers, highlighted in Yellow are the only ones I care about](https://i.stack.imgur.com/Rlkbh.png)
    
    
    
I keep trying to modify this section but with no success.
    
    ' Write the constructed JSON for the row to the file
    If CRow < TRow Then
        Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "},"
    Else
        ' Print the JSON without the trailing comma for the last row
        Print #fileNumber, txt & VBA.vbTab & VBA.vbTab & "}"
    End If

Answer 1

这是一种删除“额外”逗号的潜在方法：

Private Sub CommandButton1_Click()
    Dim TRow As Long, CRow As Long, CCol As Long, TCol As Long
    Dim Ws As Worksheet, txt As String, yesNo As String
    Dim fileSaveName As String, fileNumber As Integer
    Dim json As String '###
    
    Set Ws = ThisWorkbook.Worksheets("Paste to TEMPLATE")
    TCol = Ws.Cells.CurrentRegion.Columns.Count
    TRow = Ws.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
    
    ' Open a file save dialog to get the path and name for the JSON file
    fileSaveName = Application.GetSaveAsFilename(fileFilter:="JSON Files (*.json), *.json")
    If fileSaveName = False Then Exit Sub 'early exit reduces nesting level of following code...
    
    fileNumber = FreeFile
    Open fileSaveName For Output As fileNumber ' Open the file for writing
    
    ' Write the beginning of the JSON structure
    json = "{" & vbCrLf & vbTab & """systemId"":12," & vbCrLf & _
                vbTab & """prismIntakes"":[" & vbTab
    
    ' Loop through each row in the worksheet
    For CRow = 2 To TRow
        
        ' Check if the first column of the row is not empty
        If VBA.Trim(Ws.Cells(CRow, 1).Value) <> "" Then
            
            ' Initialize text variable
            json = json & Tabs(2) & "{" '& VBA.vbCrLf
            txt = ""
            
            For CCol = 1 To TCol ' Loop through each column in the row
                '...
                'build txt here
                '...
            Next CCol
            json = json & txt & Tabs(2) & "},"
        End If
        
    Next CRow
    
    '### remove trailing comma
    If Right(json, 1) = "," Then json = Left(json, Len(json) - 1)
    
    ' Write the end of the JSON structure
    Print #fileNumber, json & vbTab & "]" & vbCrLf & "}"
    Close fileNumber ' Close the file
         
End Sub

'return `n` consecutive tab characters
Function Tabs(n As Long) As String
    Tabs = String(n, vbTab)
End Function