如何使用URL中数字范围为的VBA-JSON解析数据？

需要使用VBA-JSON从URL中的数字发生变化的不同URL中提取数据

我正在从我玩的加密游戏中收集数据。我已经能够使用站点的API为我的“mons”解析数据了。我试图为游戏中的所有MON收集相同的数据。该API允许您一次提取99个MON的数据（每次上限为99）。目前大约有48000个MON，而且这个数字还在继续上升。每个mon都有一个ID号（1是有史以来第一个捕获到的，之后每个mon都有n+1）

这是访问mons 1-99数据的链接：

我需要把mons 1-99、100-198、199-297等的数据一直拉到48000

从每个月开始，我想收集ID号、“班级名称”、“总等级”、“完美率”、“创建索引”（这些都是DICT），最重要的是我想收集“总战斗统计”（这是一个数组）

下面是我为清单中的mons提取所有这些变量的代码（它引用了一个不同的链接），但是它已经包括了我想要它的方式安排

我只需要这些相同的变量，但引用了一堆不同的链接，而不仅仅是一个

选项显式

公共子写入BattleInfo（） Dim headers（），r为Long，i为Long，json为Object，key为Variant，ws为Worksheet，battleStats为Object 设置ws=ThisWorkbook.Worksheets（“Sheet1”） 标题=数组（“怪物”、“名字”、“总等级”、“完美”、“捕获数量”、“生命”、“PA”、“PD”、“SA”、“SD”、“SPD”）

端接头

我希望它看起来像这样：

---

但是我想要从ID 1到48000的所有MON。

您可以使用一个函数来增加ID以连接到一个基本url。如果您的请求太快/可能太多次，该站点将限制/阻止。检查文档以获取有关此方面的任何建议

我向你展示了如何找回所有。我包含了一个1到5个请求的测试用例（取消注释以获得完整的请求数）。注意：我给了一行，供您调整，它允许每x个请求添加一个延迟，以尝试避免限制/阻塞。在这种情况发生之前，这个数字似乎很低

稍后，您可以考虑将此移动到一个类中，以保存XMLHTTP对象，并提供它的方法，例如GETETEMS。

选项显式
公共子写入BattleInfo（）
Const BASE_URL作为字符串=”https://www.etheremon.com/api/monster/get_data?monster_ids="
Const END_计数长度=48000
常量批量大小（长=99）
Dim numberOfRequests As Long、i As Long、j As Long、ID As String
Dim headers（），r为长，json为对象，键为变量，ws为工作表，battleStats为对象
设置ws=ThisWorkbook.Worksheets（“Sheet1”）
标题=数组（“怪物”、“名字”、“总等级”、“完美”、“捕获数量”、“生命”、“PA”、“PD”、“SA”、“SD”、“SPD”）
numberOfRequests=Application.WorksheetFunction.RoundDown（结束计数/批次大小，0）
1.7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 7 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 95,96,97,98,99“
Dim结果（）
重拨结果（1到结束计数，1到11）
r=1
使用CreateObject（“MSXML2.XMLHTTP”）
对于i=1到5'的numberOfRequests+1
如果i Mod 10=0，则Application.Wait Now+时序（0,0,1）
如果i>1，则ids=IncrementIds（ids、批大小、结束计数）
.打开“获取”，基本URL和ID，False
.发送
设置json=JsonConverter.ParseJson（.responseText）（“数据”）
对于json.keys中的每个键
结果（r，1）=关键
结果（r，2）=json（键）（“类名称”）
结果（r，3）=json（关键）（“总体水平”）
结果（r，4）=json（关键）（“完美率”）
结果（r，5）=json（键）（“创建索引”）
设置battleStats=json（关键）（“总作战统计数据”）
对于j=1到battleStats.Count
结果（r，j+5）=作战统计项目（j）
下一个j
r=r+1
下一个
下一个
以
ws.Cells（1，1）.Resize（1，UBound（标题）+1）=标题
ws.Cells（2，1）.Resize（UBound（results，1），UBound（results，2））=结果
端接头
公共函数incrementId（ByVal id作为字符串，ByVal BATCH_SIZE作为Long，ByVal END_COUNT作为字符串）
Dim i为长，arrayIds（）为字符串
arrayIds=Split（id，“，”）
对于i=LBound（arrayIds）到UBound（arrayIds）
如果CLng（阵列ID（i））+批量大小我看不到预期的结果。你能与其他链接共享网站共享吗？让我知道这是否有效。真是太感谢你了。你帮了我很多。我现在正在尝试I=1到请求数+1。我确定这需要一段时间，我一直在失去连接-我想这是在加载。如果我只是t/1到“精确数字”？我会先处理一下延迟问题。我认为问题在于请求的速度，可能还有数量。我尝试过每100个请求引入一次等待，然后每25个，然后每10个请求引入一次等待，但仍然会延迟，尽管每10个请求Excel都没有冻结，所以它可能处理得很慢。你需要找到微妙的平衡需要在等待之前发出多少请求，以便站点不会认为您试图发送垃圾邮件（例如，请参阅DDoS）记住API也有呼叫速率限制。它需要485个呼叫来获取所有的数据。再次感谢所有的帮助。要做一些研究并查看你给出的例子/引用。当我发现什么工作时，我会让你知道。不过，如果你不介意离开，只是继续翻转，你可以考虑增加一个长。每5条记录等待一次，甚至切换到
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

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