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