用vba嵌套json物件

我在互聯網上發現了這個代碼，它可以從excel檔案中創建一個json檔案。 http://www.excelvbamacros.in/2015/01/export-range-in-jason-format.html

這是代碼：

Public Sub create_json_file()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False False
應用程式.DisplayStatusBar = False
應用程式.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False[/span

Dim fsAs Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dimcolumncounter As Long
Dim linedataAs String

Range("A1").Select
Selection.End(xlDown).Select。
Dim lRow As Long
lRow = ActiveCell.Row

Set rangetoexport = Sheets(1).Range("A1:N"/span> & lRow)
Set fs = CreateObject("Scripting.FileSystemObject" )

Set jsonfile = fs.CreateTextFile("C:UsersDesktop" & "jsondata.txt", True)

linedata = "["
jsonfile.WriteLine linedata

For rowcounter = 2 To rangetoxport.Rows.Count
    linedata = "" 

    For columncounter = 1 To rangetoexport.Columns.Count
        linedata = linedata & """" & rangetoexport. Cells(1, columncounter) & """" & ":" & """" & rangetoxport. Cells(rowcounter, columncounter) & """" & "，"。
    下一頁
    linedata = Left(linedata, Len(linedata) - 1)
    
    If rowcounter = rangetoexport.Rows.Count Then
        linedata = "{"/span> & linedata & "}"/span>
    Else
        linedata = "{" & linedata & "}，"
    End If
jsonfile.WriteLine linedata
下一個
linedata = " ]"

jsonfile.WriteLine linedata
jsonfile.Close

Set fs = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = TrueTrueTrue
ActiveSheet.DisplayPageBreaks =True

End Sub

它作業得很完美，但我的json必須要有一個嵌套的json物件。它需要看起來像這樣：

{
"a"/span>: "1234"。
"b": 0,
"c": true。
"d": true,
"e": 1,
"f": 24,
"g": null,
"h":
    {
        "j": 151.70,
        "k": 1,
        "l": 2,
        "m": true。
    },
"n": null,
"y": true。
"z": -1.
}

代碼這樣做：

{
"a"/span>: "1234"。
"b": 0,
"c": true。
"d": true,
"e": 1,
"f": 24,
"g": null,
"h": "": null.
"j": 151.70,
"k": 1,
"l": 2,
"m": true, "m".
"n": null,
"y": true。
"z": -1.
}

a,b,h...這些是列，而我的例子只是一行。 我無法添加到代碼中，以便它能創建"h":部分。 有人能幫助我嗎？

uj5u.com熱心網友回復：

在sheet1的回圈中為sheet2添加另一個回圈。

Option Explicit

Public Sub create_json_file()
   
    Const FILENAME = "jsondata.txt" 
    Const FOLDER = "C:UsersDesktop" 
    Const q = """"

    Dim ar1, ar2, fso, ts
    Dim r As Long, c As Long, c2 As Long, lrow As Long.
    Dim s As String

    lrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp) .Row
    ar1 = Sheets(1).Range("A1:K" & lrow) .Value2
    ar2 = Sheets(2).Range("A1:D" & lrow) .Value2

    ' 建立json字串。
    s = " [{" & vbCrLf

    For r = 2 To UBound(ar1)
        If r > 2 Then s = s & " ,{"/span> & vbCrLf

        For c = 1 To UBound(ar1, 2)
            If c > 1 Then s = s & " ，" & vbCrLf
            s = s & q & ar1(1, c) & q & " :"

            如果 ar1(1, c) = "h" Then
                s = s & "{"/span> & vbCrLf
                For c2 = 1 To UBound（ar2, 2）。
                    If c2 > 1 Then s = s & " ,"
                    s = s & q & ar2(1, c2) & q & " :" _
                          & q & ar2(r, c2) & q
                接下來
                s = s & "}"
            Else
                s = s & q & ar1(r, c) & q
            End If
        下一步 下一步
        s = s & "}"/span> & vbCrLf
    Next
    s = s & " ]"

    ' 寫出來
    Set fso = CreateObject("Scripting.FileSystemObject"/span>)
    Set ts = fso.CreateTextFile(FOLDER & FILENAME, True)
    ts.Write s
    MsgBox lrow - 1 & " rows exported to " & FOLDER & FILENAME, vbInformation
End Sub

標籤：

上一篇：如何在Angular10 中使用我的formBuilder.group中的兩個組來驗證一個反應式表單

下一篇：保留所有字母以及數字和下劃線的Regex（印地語字母的問題）。