VBA脚本从excel到JSON的问题

Question

我怎么也想不出如何去掉 json 输出末尾的这个逗号。

这是我正在使用的脚本......

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)

我一直尝试修改此部分，但没有成功。

' 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