用vba將excel轉換成json

我有這樣的代碼。它將一個excel檔案轉換為json格式。a, b, c...是我的標題：

Public Sub json_file()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False False

Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rangetoexport2 As 范圍
Dim rangetoexport3 As 范圍
Dim rowcounter As Long
Dimcolumncounter As Long
Dim linedata As String
Dim rng As 范圍

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

Set rangetoexport = Sheets(1).Range("A1:N"/span> & lRow)
Set rangetoexport2 = Sheets(1).Range("H1:K"/span> & lRow)
Set rangetoexport3 = Sheets(1).Range("L1:N"/span> & lRow)

Set fs = CreateObject("Scripting.FileSystemObject" )

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

linedata = "["
jsonfile.WriteLine linedata

For rowcounter = 2 To rangetoxport.Rows.Count
linedata = "" 
    For columncounter = 1 To 7
        linedata = linedata & """" & rangeto export. Cells(1, columncounter) & """" & "：" & """" & rangetoexport. Cells(rowcounter, columncounter) & """" & "，"。
    下一頁
    linedata = Left(linedata, Len(linedata) - 1)
    
    For columncounter = 1 To 4
        linedata = linedata & """" & rangeto export2. Cells(1, columncounter) & """" & ":" & " & rangetoexport2. Cells(rowcounter, columncounter) & "" & ","。
    下一個
    linedata = Left(linedata, Len(linedata) - 1)
        
    For columncounter = 1 To 3
        linedata = linedata & """" & rangeto export3. Cells(1, columncounter) & """" & ": " & """" & rangetoexport3. 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
應用程式.螢屏更新 = True

End Sub

這就是一行的輸出情況：

{"a": "1234", "b": "0", "c": "true", "d": "true", "e": "1", "f": "24", "g": "null"（它沒有在這里放一個逗號）"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,
"thresholdValues":
   {
    "j": 151.70,
    "k": 1,
    "l": 2,
    "m": true。
   },
"n": null,
"y": true。
"z": -1.
}

所以我需要在開頭添加, "thresholdValues": {在頁眉j的開頭，而},在頁眉m的結尾，有什么方法可以做到嗎？

uj5u.com熱心網友回復：

嘗試一下

Option Explicit

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

    Dim ar1, 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:N" & 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
            如果 c = 8 然后
                s = s & q & "thresholdValues" & q & ":{"。
                For c2 = 0 To 3
                    如果 c2 > 0 Then s = s & " ，"
                     s = s & q & ar1(1, c2   c) & q & " :"/span> 
                     如果 c2 = 0 則
                         s = s & ar1(r, c2   c)
                     Else
                         s = s & q & ar1(r, c2   c) & q
                     結束 If
                下一步 下一步
                s = s & "}"/span>
                c = c   3
            Else
                s = s & q & ar1(1, c) & q & ":"/span> & q & ar1(r, c) & q
            結束 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

標籤：

上一篇：當頁面重繪時，延遲canActivate的呼叫，以等待資料加載。

下一篇：根據'%'符號分割pyspark資料框架的列