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 -战斗状态：218288221198198227201

我希望A行包含以下粗体标题：Monster＃，Name，Total Level，Perfect，Catch Number，HP，PA，PD，SA，SD，SPD（战役统计不是标题，而是个人战斗统计数据）。

在下面，以本周一为例，将是：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

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

1 个答案: