如何在VBA Excel中以良好格式显示JSON对象

mxg2im7a  于 2023-08-08  发布在  其他
关注(0)|答案(4)|浏览(122)

我知道在单元格Excel中显示我的解析Json时,Json是“简单”(当它只是字符串内),但现在我有字符串,对象和数组,我有点迷失..我的json如下:

[
    {
        "name": null,
        "type": null,
        "actions": [],
        "screen": null,
        "container": null,
        "sysid": 5,
        "uftitem": null
    },
    {
        "name": null,
        "type": null,
        "actions": [],
        "screen": null,
        "container": null,
        "sysid": 6,
        "uftitem": null
    },
    {
        "name": "UTProject5",
        "type": "type",
        "actions": [
            {
                "name": "UTProject",
                "description": "UTProject",
                "pattern": "UTProject",
                "isCheck": true,
                "sysid": 1,
                "uftaction": {
                    "sysid_uftAction": 2,
                    "code": "code uft",
                    "maxTime": 10,
                    "nbCycle": 20
                }
            },
            {
                "name": "UTProject2",
                "description": "UTProject",
                "pattern": "UTProject",
                "isCheck": true,
                "sysid": 3,
                "uftaction": {
                    "sysid_uftAction": 4,
                    "code": "code uft",
                    "maxTime": 10,
                    "nbCycle": 20
                }
            }
        ],
        "screen": {
            "name": null,
            "type": null,
            "actions": [],
            "screen": null,
            "container": null,
            "sysid": 5,
            "uftitem": null
        },
        "container": {
            "name": null,
            "type": null,
            "actions": [],
            "screen": null,
            "container": null,
            "sysid": 6,
            "uftitem": null
        },
        "sysid": 7,
        "uftitem": {
            "code": "code",
            "parentCode": "tooooz",
            "sysid": 8
        }
    },
    {
        "name": "UTProject6",
        "type": "type",
        "actions": [
            {
                "name": "UTProject",
                "description": "UTProject",
                "pattern": "UTProject",
                "isCheck": true,
                "sysid": 1,
                "uftaction": {
                    "sysid_uftAction": 2,
                    "code": "code uft",
                    "maxTime": 10,
                    "nbCycle": 20
                }
            },
            {
                "name": "UTProject2",
                "description": "UTProject",
                "pattern": "UTProject",
                "isCheck": true,
                "sysid": 3,
                "uftaction": {
                    "sysid_uftAction": 4,
                    "code": "code uft",
                    "maxTime": 10,
                    "nbCycle": 20
                }
            }
        ],
        "screen": {
            "name": null,
            "type": null,
            "actions": [],
            "screen": null,
            "container": null,
            "sysid": 5,
            "uftitem": null
        },
        "container": {
            "name": null,
            "type": null,
            "actions": [],
            "screen": null,
            "container": null,
            "sysid": 6,
            "uftitem": null
        },
        "sysid": 9,
        "uftitem": {
            "code": null,
            "parentCode": null,
            "sysid": 10
        }
    }
]

字符串
我想访问我想要的并显示在单元格中,但我不知道数组和对象中的访问。
谢谢大家!

amrnrhlw

amrnrhlw1#

一般信息:

您可以使用下面的代码清空整个代码,该代码使用JSON converter

备注:

我正在从工作表中阅读JSON字符串,并通过JSONConverter存储在对象中。初始对象是集合。我使用TypeName函数 * 循环该集合和每个嵌套级别,以确定每个级别存储了哪些对象。然后,我使用Select Case适当地处理这些对象。
更有效的方法是设计一个可重用的类来处理这个问题。我在SO上看到了一些其他的问题,这是在哪里做的。

  • VarType实际上更健壮
    JSON示例

x1c 0d1x的数据

输出到立即窗口的示例代码:

通过将Debug.Print语句替换为工作表区域的赋值语句,可以选择写入单元格的方式。


VBA:

Option Explicit
Public Sub GetInfoFromSheet()
    Dim jsonStr As String
    jsonStr = [A1]                               '<== read in from sheet
    Dim json As Object
    Set json = JsonConverter.ParseJson(jsonStr)

    Dim i As Long, j As Long, key As Variant
    For i = 1 To json.Count
        For Each key In json(i).keys
            Select Case key
            Case "name", "type"
                Debug.Print key & " " & json(i)(key)
            Case Else
                Select Case TypeName(json(i)(key))
                Case "Dictionary"
                    Dim key2 As Variant
                    For Each key2 In json(i)(key)
                        Select Case TypeName(json(i)(key)(key2))
                        Case "Collection"
                            Dim k As Long
                            For k = 1 To json(i)(key)(key2).Count
                                Debug.Print key & " " & key2 & " " & json(i)(key)(key2)(k)
                            Next k
                        Case Else
                            Debug.Print key & " " & key2 & " " & json(i)(key)(key2)
                        End Select
                    Next key2
                Case "Collection"
                    For j = 1 To json(i)(key).Count '<== "actions"
                        Dim key3 As Variant
                        For Each key3 In json(i)(key)(j).keys
                            Select Case TypeName(json(i)(key)(j)(key3))
                            Case "String", "Boolean", "Double"
                                Debug.Print key & " " & key3 & " " & json(i)(key)(j)(key3)
                            Case Else
                                Dim key4 As Variant
                                For Each key4 In json(i)(key)(j)(key3).keys
                                    Debug.Print key & " " & key3 & " " & key4 & " " & json(i)(key)(j)(key3)(key4)
                                Next key4
                            End Select
                        Next key3
                    Next j
                Case Else
                    Debug.Print key & " " & json(i)(key)
                End Select
            End Select
        Next key
    Next i
End Sub

字符串

tl;dr;教程点:

因此,以上可能已经有点充分,因为它得到了一切没有大量的解释。下面,我们将更详细地介绍如何通过相关的VBA来定位JSON和 “talk”
为此,您可以使用在线JSON解析器来更清楚地查看JSON的结构。我把你的JSON字符串放到Json Parser Online中,然后检查了String/parseJS eval中的结构;左手部分。还有其他工具可用。
首先要注意的是开头的"["。你可以在下面看到的第一个。



这表示Collection对象,当使用JsonConverter转换时,它是您的JSON字串。所有其他内容都嵌套在"["的左括号和最后的右括号之间。
接下来要注意的是,这是一个字典的集合,所以在其中形成“组”的一切都是字典。



看到"{"表示字典的开始了吗?
该词典的关键字为"name","type","actions"等。
一个初步的观察是,许多这些信息是空的,即。null的数据。我们可以使用IsNull测试忽略这些(我选择根据"name"字段执行此操作):

If Not IsNull(json(i)("name"))


我们还可以看到,在"name"不是null的字典中,"actions"包含另一个字典集合。您可以看到,"["后跟"{",如前所述。
x1c4d 1x型
我们可以看到,每个内部字典都有"name", "description"等的关键字。我们还可以看到它们的值具有不同的数据类型。
观察JSON结构中的"actions",您可以看到以下内容(使用示例字典):
1.字符串x1m 25n1x
1.字符串"description":"UTProject"
1.字符串“pattern":"UTProject"
1.布尔型"isCheck":true
1.双人间"sysid":1
1.字典"uftaction" 'keys of ==> "sysid_uftAction":2,"code":"code uft","maxTime":10,"nbCycle":20
因此,我们可以通过使用TypeName进行测试,使用Select Case来处理数据类型
对于基本的布尔型、字符串型和双精度型数据类型,我们可以简单地通过使用键(例如

json(i)("actions")(j)("isCheck")


这将是TrueFalse.ij的布尔结果,TrueFalse.ij是外部和内部集合的循环中的当前位置的索引。
对于字典"uftaction",我们可以在其键上循环:

For Each key2 In json(i)("actions")(j)(key).keys 
    Debug.Print "actions " & key & " " & key2 & " " & json(i)("actions")(j)(key)(key2)
Next key2


当然,您也可以使用键的名称进行访问,而无需在键的末尾循环,例如:

json(i)("actions")(j)(key)("maxTime")


在整个过程中,你可以通过索引而不是循环访问特定的位置,这样ij就可以直接用一个数值替换。和key, key2等可以由任何给定的 key 的实际文字字符串替换。
希望这能让你有更多的了解。

VBA:

Option Explicit
Public Sub GetInfoFromJSON()
    Dim jsonStr As String
    jsonStr = [A1]                               '<== read in from sheet
    Dim json As Object, i As Long
    Set json = JsonConverter.ParseJson(jsonStr) '<==This is a collection verified by Debug.Print TypeName(JSON)
    For i = 1 To json.Count
        If Not IsNull(json(i)("name")) Then
            'ignore the null names which have sys id only populated
            Debug.Print "name" & " " & json(i)("name")
            Debug.Print "type" & " " & json(i)("type")
            Dim j As Long
            For j = 1 To json(i)("actions").Count 'actions are a collection of dictionaries
                Dim key As Variant
                For Each key In json(i)("actions")(j).keys 'dictionary
                    'observing actions in the JSON structure you can see there are:
                    '                    String  "name":"UTProject"
                    'String "description":"UTProject",
                    'String "pattern":"UTProject",
                    'Boolean "isCheck":true,
                    'Double "sysid":1,
                    'Dictionary "uftaction" '==> "sysid_uftAction":2,"code":"code uft","maxTime":10,"nbCycle":20
                    'So we can use Select Case to handle the data type by testing with TypeName
                    Select Case TypeName(json(i)("actions")(j)(key))
                    Case "String", "Boolean", "Double" '<==good to go nothing extra needed
                        Debug.Print "actions " & key & " " & json(i)("actions")(j)(key)
                    Case Else                    ' we are dealing with uftaction which we know is a dictionary
                        Dim key2 As Variant
                        For Each key2 In json(i)("actions")(j)(key).keys '<==We know now we are looping the uftaction dictionary which has keys "sysid_uftAction","code","maxTime","nbCycle"
                            Debug.Print "actions " & key & " " & key2 & " " & json(i)("actions")(j)(key)(key2)
                        Next key2
                    End Select
                Next key
            Next j
        End If
    Next i
End Sub

x7yiwoj4

x7yiwoj42#

我创建了这个简单的函数来格式化Json字符串,如果有人需要的话。代码非常简单。

Public Function indentJson(ByVal jsonIn As String) As String

Dim posizioneIndent As Integer
Dim contatore As Integer
Dim lungheza As Integer
Dim JsonOut As String
Dim i As Integer
Dim carattere As String

JsonOut = ""
lunghezza = Len(jsonIn)
contatore = 1
posizioneIndent = -1
carattere = ""

While contatore <> lunghezza + 1
        
    carattere = Mid(jsonIn, contatore, 1)
    
  If carattere = "{" Or carattere = "[" Then
    
     JsonOut = JsonOut & carattere
   JsonOut = JsonOut & Chr(13) & Chr(10)
     posizioneIndent = posizioneIndent + 1
     For i = 0 To posizioneIndent
     JsonOut = JsonOut & Space(5)
     Next i

  ElseIf carattere = "}" Or carattere = "]" Then
     JsonOut = JsonOut & Chr(13) & Chr(10)
     posizioneIndent = posizioneIndent - 1
     For i = 0 To posizioneIndent
      JsonOut = JsonOut + Space(5)
     Next i
     JsonOut = JsonOut + carattere
     'For i = 0 To posizioneIndent
     ' JsonOut = JsonOut + Space(5)
     'Next i

  ElseIf carattere = "," Then
JsonOut = JsonOut & carattere
JsonOut = JsonOut & Chr(13) & Chr(10)
For i = 0 To posizioneIndent
JsonOut = JsonOut + Space(5)
Next i

  Else
   JsonOut = JsonOut + carattere

End If

contatore = contatore + 1

Wend

indentJson = JsonOut

End Function

字符串
这是结果,在我的情况下,我把它放在一个文本框,如果有人有一个建议,以改善,请告诉我。

{
     "routingResponse":{
          "currentTimeUTC":"2022-10-16-09.16.48.012243+02:00",
          "executionMessage":{
               "code":0,
               "severity":"INFO",
               "codeDesc":"",
               "message":""
          },
          "arrivalTerminal":"031",
          "arrivalDepot":"031",
          "deliveryZone":"20",
          "consigneeZIPCode":"95024",
          "consigneeCity":"ACIREALE",
          "consigneeProvinceAbbreviation":"CT"
     }
}

8zzbczxx

8zzbczxx3#

看看下面的例子。JSON.bas模块导入VBA工程进行JSON处理。

Option Explicit

Sub Test()

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

    ' Read JSON sample from file C:\Test\sample.json
    sJSONString = ReadTextFile("C:\Test\sample.json", 0)
    ' Parse JSON sample
    JSON.Parse sJSONString, vJSON, sState
    If sState = "Error" Then
        MsgBox "Invalid JSON"
        End
    End If
    ' Convert raw JSON to 2d 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 2d 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

Function ReadTextFile(sPath As String, lFormat As Long) As String

    ' lFormat -2 - System default, -1 - Unicode, 0 - ASCII
    With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, lFormat)
        ReadTextFile = ""
        If Not .AtEndOfStream Then ReadTextFile = .ReadAll
        .Close
    End With

End Function

字符串
顺便说一句,类似的方法应用于in other answers

ifsvaxew

ifsvaxew4#

我是这么做的:

Public Function indentJsonV2(ByVal jsonIn As String) As String
    Dim positionIndent As Double: positionIndent = -1
    Dim counter As Double: counter = 1
    Dim theLength As Double: theLength = Len(jsonIn)
    Dim JsonOut As String: JsonOut = vbNullString
    Dim i As Double: i = 0
    Dim theChar As String: theChar = vbNullString
    Dim twoChars As String: twoChars = vbNullString
    While counter <> theLength + 1
        theChar = Mid(jsonIn, counter, 1)
        twoChars = Mid(jsonIn, counter, 2)
        If theChar = "{" Or theChar = "[" Then
            JsonOut = JsonOut & theChar
            JsonOut = JsonOut & Chr(13) & Chr(10)
            positionIndent = positionIndent + 1
            For i = 0 To positionIndent
                JsonOut = JsonOut & Space(5)
            Next i
        ElseIf theChar = "}" Or theChar = "]" Then
            JsonOut = JsonOut & Chr(13) & Chr(10)
            positionIndent = positionIndent - 1
            For i = 0 To positionIndent
                JsonOut = JsonOut + Space(5)
            Next i
            JsonOut = JsonOut + theChar
            'For i = 0 To positionIndent
            ' JsonOut = JsonOut + Space(5)
            'Next i
        ElseIf twoChars = "]," Or twoChars = "}," Or twoChars = ",""" Then
            JsonOut = JsonOut & theChar
            JsonOut = JsonOut & Chr(13) & Chr(10)
            For i = 0 To positionIndent
                JsonOut = JsonOut + Space(5)
            Next i
        Else
            JsonOut = JsonOut + theChar
        End If
        counter = counter + 1
    Wend
    indentJsonV2 = JsonOut
End Function

字符串

相关问题