Цикл по ключам объектов JSON в Excel VBA

Question

Я пытаюсь узнать о JSON в Excel VBA, так что держите меня .. Это образец 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"}

Это значение находится в диапазоне («А1»), и я использовал этот код для циклического просмотра каждого ключа и отладки ключа и соответствующего значения

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

Код работает хорошо при обычных комбинациях ключа и значения, но обнаружил ошибку в ключе «Рейтинги», поскольку он не такой, как у других. Как я могу напечатать значение этого ключа без вложенных циклов.Я имею в виду, чтобы напечатать этот вывод

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

Спасибо заранее за помощь

Answer 1

Звучит так, как если бы вы могли привести в соответствие значения:

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

Answer 2

Я бы, вероятно, использовал рекурсивный сабвуфер для очистки всех словарей, в том числе и внутри коллекции.Он имеет уровень вложенности, но он минимален.

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, чтобы выписать результаты внутренних словарей.

---

Toсгенерировать показанную строку, вам нужно только то, что находится в коллекции:

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