如何将 VBA-JSON 输出移动到工作表中的特定单元格？

Question

对 VBA 非常陌生。尝试尽可能多地学习。我可以在即时窗口中获得我想要的输出，但是如何将所有这些都移动到我的工作表中？

老实说，我不确定要尝试什么或在哪里尝试。

Option Explicit

Sub JsonMain()
    Dim dict
    Dim subDict
    Dim strLine As String

    ' Read from file
    Dim FilePath As String
    FilePath = ThisWorkbook.Path + "\" + "Main.json"

    Dim nFile As Integer
    Dim strJson As String
    nFile = FreeFile
    Open FilePath For Input As #nFile
    strJson = Input(LOF(nFile), nFile)
    Close #nFile

    Dim jp As Scripting.Dictionary
    Set jp = JsonConverter.ParseJson(strJson)

    Dim gameData As Scripting.Dictionary
    Set gameData = jp("data")

    Dim theseMonsters As Object
    Set theseMonsters = gameData("monsters")

    Debug.Print "there are " & theseMonsters.Count & " monsters in the profile"

    Dim i As Long
    Dim monster As Dictionary
    Dim monsterName As Variant
    Dim monsterDetails As Variant
    For Each monsterName In theseMonsters.Keys
        Debug.Print "Monster #" & monsterName
        Set monsterDetails = theseMonsters(monsterName)
        Debug.Print " --               name: " & monsterDetails("class_name")
        Debug.Print " --        total level: " & monsterDetails("total_level")
        Debug.Print " --         perfection: " & monsterDetails("perfect_rate")
        Debug.Print " --       catch number: " & monsterDetails("create_index")
        Dim battleStats As Collection
        Set battleStats = monsterDetails("total_battle_stats")
        Debug.Print " -- battle stats: ";
        For i = 1 To battleStats.Count
            Debug.Print battleStats.Item(i) & " ";
        Next i
        Debug.Print ""
        ' ...
    Next monsterName
End Sub

编辑 1：

预期结果将是打印在 A 行中的每个类别的粗体标题，数据在这些标题下的列中向下排列。

这是我在即时窗口中获得的示例输出：

怪物#47103 -- 名称：Monstratos -- 总等级：20 -- 完美：53.763 -- 捕获数：39 -- 战斗数据：218 288 221 198 227 201

我希望 A 行包含这些粗体标题：Monster #、Name、Total Level、Perfection、Catch Number、HP、PA、PD、SA、SD、SPD（Battle Stats 不是标题，而是个人战斗统计数据）。

下面，以这个 mon 为例，将是：47103, Monstratos, 20, 53.763, 39, 218, 288, 221, 198, 227, 201。

Answer 1

我认为您想要以下内容。每次点击新的 monster 字典时，都会增加行计数器 r。对于 monster 字典中的每个感兴趣的项目，该列增加 1。

Option Explicit  
Public Sub WriteOutBattleInfo()
    Dim headers(), r As Long, i As Long, json As Object, key As Variant, ws As Worksheet, battleStats As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    headers = Array("Monster #", "Name", "Total Level", "Perfection", "Catch Number", "HP", "PA", "PD", "SA", "SD", "SPD")

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.etheremon.com/api/user/get_my_monster?trainer_address=0x2Fef65e4D69a38bf0dd074079f367CDF176eC0De", False
        .send
        Set json = JsonConverter.ParseJson(.responseText)("data")("monsters") 'dictionary of dictionaries
    End With
    r = 2
    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    For Each key In json.keys
        With ws
            .Cells(r, 1) = key
            .Cells(r, 2) = json(key)("class_name")
            .Cells(r, 3) = json(key)("total_level")
            .Cells(r, 4) = json(key)("perfect_rate")
            .Cells(r, 5) = json(key)("create_index")
            Set battleStats = json(key)("total_battle_stats")

            For i = 1 To battleStats.Count
                .Cells(r, i + 5) = battleStats.item(i)
            Next i
        End With
        r = r + 1
    Next
End Sub