json - VBA解析json并循环不同的对象

Question

我正在尝试使用 VBA 将sheet1单元格(B11:B15)中编写的API中的JSON数据解析为Excel:单元格 B11 中的 API =

Api 相同，仅更改 ID

这是我正在使用的代码:

Option Explicit
Public r As Long, c As Long
Sub readValues()
    Dim sJSONString As String
    Dim ws As Worksheet
    Dim a As Integer
    Dim ID As String
    Dim I As Integer

    For a = 11 To 15
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Foglio1.Cells(a, 2), False
        .send
        sJSONString = .responseText
        'MsgBox sJSONString
    End With

    Dim JSON As Object, item As Object

    ID = Foglio1.Cells(a, 1)

    Set JSON = JsonConverter.ParseJson(sJSONString)("data")(ID)("statistics")("all")

    r = 1: c = 1

    EmptyDict JSON

    Next a
End Sub

Public Sub EmptyDict(ByVal dict As Object)

    Dim key As Variant, item As Object

    Select Case TypeName(dict)
    Case "Collection"

    For Each item In dict
        c = c
        r = r + 1
        EmptyDict item
    Next

    Case "Dictionary"
        For Each key In dict
            If TypeName(dict(key)) = "Collection" Then
                EmptyDict (dict(key))
            Else
                With ThisWorkbook.Worksheets("foglio1")
                    .Cells(r + 9, c + 5) = (key)
                    .Cells(r + 10, c + 5) = dict(key)
                End With
                c = c + 1
            End If

        Next

    End Select
End Sub

代码工作正常，但无法循环 5 个 ID API；该代码将所有 5 个项目写入同一行 11。此外，我想在每一行中写入“全部”、“评级”对象以及“昵称”和“上次战斗时间”。有人可以帮助我吗？谢谢

Answer 1

您重新设置的每个循环r = 1: c = 1因此您可能会覆盖。在循环外初始化 r，然后检查需要递增的位置。也许仅在函数内。

您需要确保 c 变量递增，同时 r 保持不变，以将所有内容保持在一行中。

rating 和 all 是字典，因此您必须通过键访问其中的项目。 last_battle_time 似乎是字典的键:507350581(id？)

下面从单元格中读取 json，并简单地向您展示了如何访问值。我没有使用你的功能。相反，我会在循环期间增加 r。

Option Explicit
Sub test()
    Dim json As Object
    Set json = JsonConverter.ParseJson([A1])("data")("507350581")

    Dim battle As String, nickname As String                      '<just for sake of ease using this datatype
    battle = json("last_battle_time")
    nickname = json("nickname")
    Dim rating As Object, all As Object
    Set rating = json("statistics")("rating")
    Set all = json("statistics")("all")
    Dim r As Long, c As Long
    r = 2: c = 1

    With ActiveSheet
        .Cells(r, 1).Resize(1, rating.Count) = rating.Items
        .Cells(r, 1 + rating.Count).Resize(1, all.Count) = all.Items
        .Cells(r, 1 + rating.Count + all.Count) = nickname
        .Cells(r, 2 + rating.Count + all.Count) = battle
    End With

    'rating.keys  '<= array of the keys
    'rating.items '<== array of the items
    'rating and all can be passed to your function.
    Stop
End Sub