循环浏览Excel VBA中的JSON对象键

时间:2018-10-14 12:35:53

标签: json excel vba parsing

我正在尝试在excel vba中学习JSON,所以请耐心等待.. 这是JSON示例..

{"Title":"Close-Up","Year":"1990","Rated":"NOT RATED","Released":"30 Oct 1991","Runtime":"98 min","Genre":"Documentary, Biography, Crime","Director":"Abbas Kiarostami","Writer":"Abbas Kiarostami","Actors":"Hossain Sabzian, Mohsen Makhmalbaf, Abolfazl Ahankhah, Mehrdad Ahankhah","Plot":"The true story of Hossain Sabzian that impersonated the director Mohsen Makhmalbaf to convince a family they would star in his so-called new film.","Language":"Persian, Azerbaijani","Country":"Iran","Awards":"2 wins.","Poster":"https://m.media-amazon.com/images/M/MV5BMzE4Mjc0MjI1N15BMl5BanBnXkFtZTcwNjI3MzEzMw@@._V1_SX300.jpg","Ratings":[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}],"Metascore":"N/A","imdbRating":"8.3","imdbVotes":"11,546","imdbID":"tt0100234","Type":"movie","DVD":"19 Feb 2002","BoxOffice":"N/A","Production":"Zeitgeist Films","Website":"http://www.zeitgeistfilm.com/current/closeup/closeup.html","Response":"True"}

在范围内(“ A1”) 并且我使用此代码遍历每个键并调试该键及其相关值

Sub Test()
Dim ws          As Worksheet
Dim jsonObject  As Object
Dim item        As Variant
Dim jsonText    As String

Set ws = ThisWorkbook.Worksheets("Sheet1")
jsonText = ws.Cells(1, 1).Value
Set jsonObject = JsonConverter.ParseJson(jsonText)

For Each item In jsonObject.Keys
    Debug.Print item & vbTab & jsonObject(item)
Next item
End Sub

该代码在键和值的常规组合中可以很好地工作,但是在键“ Ratings”处遇到错误,因为它与其他键不同 如何在没有嵌套循环的情况下打印此键的值。我的意思是打印此输出

[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}]

感谢高级帮助

2 个答案:

答案 0 :(得分:2)

听起来像您可能想要对值进行字符串化:

For Each item In jsonObject.Keys
    Debug.Print item, Replace(JsonConverter.ConvertToJson(jsonObject(item)), """", "")
Next item

答案 1 :(得分:1)

我可能会使用一个递归子项来清空所有字典,包括集合中的那些字典。它确实具有嵌套级别,但是数量很少。

Public Sub GetInfoFromSheet()
    Dim jsonStr As String, json As Object
    jsonStr = [A1]
    Set json = JsonConverter.ParseJson(jsonStr)
    emptyDict json
End Sub

Public Sub emptyDict(ByVal json As Object)
    Dim key As Variant, item As Object
    For Each key In json
        Select Case TypeName(json(key))
        Case "String"
            Debug.Print key & vbTab & json(key)
        Case "Collection"
            For Each item In json(key)
                emptyDict item
            Next
        End Select
    Next
End Sub

检查您的JSON结构:

您有一个初始字典,用{}表示,然后在其中有一系列键和值对以及一个用[]表示的集合。该集合也由字典组成。因此,我对TypeName使用测试来确定顶级字典值是String还是Collection。如果它是Collection,则我递归地调用emptyDict子写出内部字典的结果。

enter image description here


要生成显示的字符串,您只需要集合中的内容:

Option Explicit
'[{"Source":"Internet Movie Database","Value":"8.3/10"},{"Source":"Rotten Tomatoes","Value":"88%"}]
Public Sub GetInfoFromSheet()
    Dim jsonStr As String, json As Object, item As Object, output As String, key As Variant
    jsonStr = [A1]
    Set json = JsonConverter.ParseJson(jsonStr)("Ratings")
    For Each item In json
        For Each key In item.keys
            If key = "Value" Then
                output = output & "," & Chr$(34) & key & Chr$(34) & ":" & Chr$(34) & item(key) & Chr$(34) & "}"
            Else
                output = output & ",{" & Chr$(34) & key & Chr$(34) & ":" & Chr$(34) & item(key) & Chr$(34)
            End If
        Next key
    Next
    output = "[" & Replace$(output, ",", vbNullString, , 1) & "]"
    Debug.Print output    
End Sub