Как я могу переместить вывод VBA-JSON в определенные ячейки на листе? - PullRequest
0 голосов
/ 11 февраля 2019

Очень плохо знаком с 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, с данными, расположенными в столбцах под этими заголовками.

Вот пример вывода, который я получаю в ближайшем окне:

Monster # 47103 - имя: Monstratos - общий уровень: 20 - совершенство: 53.763 - номер улова: 39- боевая статистика: 218 288 221 198 227 201

Я бы хотел, чтобы строка А содержала следующие жирные заголовки: № монстра, имя, общий уровень, совершенство, номер улова, HP, PA, PD, SA, SD, SPD (Battle Stats - это не заголовок, но отдельные боевые характеристики).

Ниже для этого примера в качестве примера будет: 47103, Monstratos, 20, 53.763, 39, 218, 288221, 198, 227, 201.

1 Ответ

0 голосов
/ 12 февраля 2019

Я думаю, вы хотите что-то вроде следующего.Вы увеличиваете счетчик строк, r, каждый раз, когда вы нажимаете новый словарь monster .Для каждого интересующего предмета в словаре 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...