JSON VBA解析为Excel [英] JSON VBA Parse to Excel

问题描述

我进行了一些JSON解析.我使用VBA解析来自Web服务器的JSON代码，并将其写入Excel工作表中的单元格A1.但是我不知道该如何转换成其他单元格.

I got some JSON parsing working. I use VBA to parse a JSON code from my webserver, write that to cell A1 at my Excel Worksheet. But I don't get this to convert into the other cells.

这是我的JSON示例:

Here is my JSON sample:

{
    "@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，它正在处理另一个示例:

This is my Sub, it is working for another sample:

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示例像表一样放置在工作表上?

How this VBA code should be changed so that the above JSON sample to be placed on the worksheet like a table?

推荐答案

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

Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.

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上的输出如下:

The output on the worksheet #1 for the raw sample you provided is as follows:

在工作表#2上有扁平化的示例输出:

And there is the flattened sample output on the worksheet #2:

顺便说一句，在以下答案中应用了类似的方法: 1 ， 3 ，4 ， 5 ， 7 ，8 ， 9 ， 10 ， 11 ， 12 ， 13 ， 14 ， 15 ， 16 和 17

BTW, the similar approach applied in the following answers: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 and 17.

这篇关于JSON VBA解析为Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！