Как я могу проанализировать данные, используя VBA-JSON с диапазоном номеров в URL?

Question

Необходимо использовать VBA-JSON для извлечения данных из разных URL-адресов, где меняются числа в URL-адресе

Я собираю данные из крипто-игры, в которую я играю.Я уже в состоянии анализировать данные, используя API сайта только для моих "mons".Я пытаюсь собрать одинаковые данные для ВСЕХ монов в игре.API позволяет получать данные за 99 мес за один раз (ограничение за 99 за раз).Есть ок.Существуют 48 000 мес, и это число продолжает расти.Каждый мон имеет идентификационный номер (1 - первый пойманный и n + 1 для каждого после него).

Это ссылка для доступа к данным для мон. 1-99: https://www.etheremon.com/api/monster/get_data?monster_ids=1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99

Мне нужно получить данные для мон. 1-99, затем 100-198, затем 199-297 итак на всем пути до 48000.

Из каждого понедельника я хочу собрать идентификационный номер, "имя_класса", "итоговый_уровень", "идеальный_кат", "create_index" (все это дикты) и, самое главное, яхотите "total_battle_stats" (который является массивом).

Вот код, который у меня есть для извлечения всех этих переменных только для монов из моего инвентаря (он ссылается на другую ссылку), но он уже включает в себя порядок того, как я этого хочу.

Мне просто нужны те же переменные, но ссылающиеся на кучу разных ссылок, а не на одну.

Опция Явная

Public Sub WriteOutBattleInfo () Dim headers (), r As Long, i As Long, json As Object, ключ 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

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 key:=Range("C2:C110" _
    ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A1:K110")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Selection.Columns.AutoFit

End Sub

Мне бы хотелось, чтобы это выглядело именно так: https://imgur.com/a/xPA9T7W

Но я хочу, чтобы всеМонс от ID 1 до 48000.

Answer 1

Вы можете использовать функцию для увеличения идентификаторов для объединения на базовый URL.Сайт блокируется / блокируется, если вы запрашиваете слишком быстро / возможно слишком много раз.Посмотрите документацию для каких-либо советов по этому поводу.

Я покажу, как вы можете получить все.Я включаю тестовый пример для 1–5 запросов (раскомментируйте, чтобы получить полное количество запросов. Примечание. Я даю вам строку для настройки, которая позволяет добавлять с задержкой каждые x запросов, чтобы попытаться избежать троттлинга / блокировки.Вероятно, до того, как это произойдет, число будет достаточно низким.

Позже вы можете переместить это в класс для хранения объекта xmlhttp и предоставить ему такие методы, как getItems. Пример здесь .

Option Explicit

Public Sub WriteOutBattleInfo()
    Const BASE_URL As String = " https://www.etheremon.com/api/monster/get_data?monster_ids="
    Const END_COUNT As Long = 48000
    Const BATCH_SIZE As Long = 99
    Dim numberOfRequests As Long, i As Long, j As Long, ids As String
    Dim headers(), r 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")
    numberOfRequests = Application.WorksheetFunction.RoundDown(END_COUNT / BATCH_SIZE, 0)
    ids = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99"

    Dim results()
    ReDim results(1 To END_COUNT, 1 To 11)
    r = 1

    With CreateObject("MSXML2.XMLHTTP")
        For i = 1 To 5 'numberOfRequests + 1
            If i Mod 10 = 0 Then Application.Wait Now + TimeSerial(0, 0, 1)
            If i > 1 Then ids = IncrementIds(ids, BATCH_SIZE, END_COUNT)
            .Open "GET", BASE_URL & ids, False
            .send
            Set json = JsonConverter.ParseJson(.responseText)("data")

            For Each key In json.keys
                results(r, 1) = key
                results(r, 2) = json(key)("class_name")
                results(r, 3) = json(key)("total_level")
                results(r, 4) = json(key)("perfect_rate")
                results(r, 5) = json(key)("create_index")

                Set battleStats = json(key)("total_battle_stats")

                For j = 1 To battleStats.Count
                    results(r, j + 5) = battleStats.item(j)
                Next j
                r = r + 1
            Next
        Next
    End With

    ws.Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
    ws.Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
End Sub

Public Function IncrementIds(ByVal ids As String, ByVal BATCH_SIZE As Long, ByVal END_COUNT) As String
    Dim i As Long, arrayIds() As String
    arrayIds = Split(ids, ",")
    For i = LBound(arrayIds) To UBound(arrayIds)
        If CLng(arrayIds(i)) + BATCH_SIZE <= END_COUNT Then
            arrayIds(i) = arrayIds(i) + BATCH_SIZE
        Else
            ReDim Preserve arrayIds(0 To i - 1)
            Exit For
        End If
    Next
    IncrementIds = Join(arrayIds, ",")      
End Function