使用 vba 嵌套 json 对象答案

【问题标题】：Nested json object with vba使用 vba 嵌套 json 对象
【发布时间】：2023-03-12 12:00:01
【问题描述】：

我在互联网上找到了这个从 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
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim fs As Object
Dim jsonfile
Dim rangetoexport As Range
Dim rowcounter As Long
Dim columncounter As Long
Dim linedata As String

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

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

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

linedata = "["
jsonfile.WriteLine linedata

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

    For columncounter = 1 To rangetoexport.Columns.Count
        linedata = linedata & """" & rangetoexport.Cells(1, columncounter) & """" & ":" & """" & rangetoexport.Cells(rowcounter, columncounter) & """" & ","
    Next
    linedata = Left(linedata, Len(linedata) - 1)
    
    If rowcounter = rangetoexport.Rows.Count Then
        linedata = "{" & linedata & "}"
    Else
        linedata = "{" & linedata & "},"
    End If
jsonfile.WriteLine linedata
Next
linedata = "]"

jsonfile.WriteLine linedata
jsonfile.Close

Set fs = Nothing

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

效果很好，但我的 json 必须有一个嵌套的 json 对象。它需要看起来像这样：

{
"a": "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": "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,b,h... 这些是列，我的示例只有一行。我无法添加到代码中，以便创建 "h": 部分。谁能帮帮我？

【问题讨论】：

什么链接 sheet1 上的一行与 sheet2 上的一行？假设 j,k,l,m 是列标题。
我什么意思？它们是完全不同的列。是的 j,k,l,m,a,b... 是标题。但是 h 列是空的，它有类似的数组值。
某些东西必须将 sheet1 上 "a": "1234" 所在的行与 sheet2 上 "j": 151.70, 所在的行链接起来，或者两张表上的行号是否相同？
行号相同，两张表都有 1016 行。我在顶部的示例只有一行。

标签： json excel vba for-loop

【解决方案1】：

在 sheet1 的循环中为 sheet2 添加另一个循环。

Option Explicit

Public Sub create_json_file()
   
    Const FILENAME = "jsondata.txt"
    Const FOLDER = "C:\Users\Desktop\"
    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

    ' build json string
    s = "[{" & vbCrLf

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

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

            If ar1(1, c) = "h" Then
                s = s & "{" & 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
                Next
                s = s & "}"
            Else
                s = s & q & ar1(r, c) & q
            End If
        Next
        s = s & "}" & vbCrLf
    Next
    s = s & "]"

    ' write out
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.CreateTextFile(FOLDER & FILENAME, True)
    ts.Write s
    MsgBox lrow - 1 & " rows exported to " & FOLDER & FILENAME, vbInformation
End Sub

【讨论】：