Question

我有一些JSON解析工作。我使用VBA从我的网络服务器解析JSON代码，将其写入我的Excel工作表中的单元格A1。但是我没有把它转换成其他细胞。

这是我的JSON示例：

{
    "@type":["IN.areaList.1","OII.list.1"],
    "@self":"/bereiche",
    "list":[
          {"@type":["IN.bereich.1"],
           "@self":"/1.1.Bereich.2.7",
           "scha":false,
           "trlState":"",
           "oiischa":false,
           "readyTo1":false,
           "readyTo2":false,
           "numberOfBypassedDevices":0,
           "test":"",
           "TestActive":false,
           "chModeActive":false,
           "incs":[]}
            ]
}

这是我的Sub，它正在为另一个样本工作：

Sub JsonToExcelExample()

    Dim jsonText As String
    Dim jsonObject As Object
    Dim item As Object
    Dim i As Long
    Dim ws As Worksheet

    Set ws = Worksheets("Remote")
    jsonText = ws.Cells(1, 1)
    Set jsonObject = JsonConverter.ParseJson(jsonText)
    i = 3
    ws.Cells(2, 1) = "Color"
    ws.Cells(2, 2) = "Hex Code"
    For Each item In jsonObject("0")
        ws.Cells(i, 1) = item("color")
        ws.Cells(i, 2) = item("value")
        i = i + 1
    Next

End Sub

如何更改此VBA代码，以便将上述JSON示例放在工作表上，就像表一样？

Answer 1

看看下面的例子。 将JSON.bas模块导入VBA项目以进行JSON处理。

Option Explicit

Sub Test()

    Dim sJSONString As String
    Dim vJSON
    Dim sState As String
    Dim aData()
    Dim aHeader()
    Dim vResult

    ' Retrieve question #50068973 HTML content
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://stackoverflow.com/questions/50068973", False
        .send
        sJSONString = .responseText
    End With
    ' Extract JSON sample from the question
    sJSONString = "{" & Split(sJSONString, "<code>{", 2)(1)
    sJSONString = Split(sJSONString, "</code>", 2)(0)
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Convert raw JSON to array and output to worksheet #1
    JSON.ToArray vJSON, aData, aHeader
    With Sheets(1)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    ' Flatten JSON
    JSON.Flatten vJSON, vResult
    ' Convert flattened JSON to array and output to worksheet #2
    JSON.ToArray vResult, aData, aHeader
    With Sheets(2)
        .Cells.Delete
        .Cells.WrapText = False
        OutputArray .Cells(1, 1), aHeader
        Output2DArray .Cells(2, 1), aData
        .Columns.AutoFit
    End With
    MsgBox "Completed"

End Sub

Sub OutputArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

Sub Output2DArray(oDstRng As Range, aCells As Variant)

    With oDstRng
        .Parent.Select
        With .Resize( _
                UBound(aCells, 1) - LBound(aCells, 1) + 1, _
                UBound(aCells, 2) - LBound(aCells, 2) + 1)
            .NumberFormat = "@"
            .Value = aCells
        End With
    End With

End Sub

您提供的原始样本的工作表＃1上的输出如下：

工作表＃2上有扁平的样本输出：

顺便说一句，类似的方法适用于以下答案：1，2，3，4，5，6， 7，8，9，10，11，12，13，14，{{ 3}}，15和16。

JSON VBA解析到Excel

1 个答案: