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；该代码在同一行11中写入所有5个项目。此外，我想在每一行中写入“所有”，“评分”对象以及“昵称”和“最后战斗时间”。有人可以帮我吗？谢谢

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

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

1 个答案: