Excel VBA中json数组最大值的无迭代提取

cidc1ykv  于 2023-03-04  发布在  其他
关注(0)|答案(2)|浏览(131)

我有一个JSON数据字符串,我尝试从其中提取"id"的最大值,而不进行迭代。
以下是JSON数据字符串:

"ball_coordinates": [
            {
                "id": 3938706,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "17:20",
                "x": "106",
                "y": "57"
            },
            {
                "id": 3938771,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "18:17",
                "x": "15",
                "y": "75"
            },
            {
                "id": 3939282,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "28:47",
                "x": "21",
                "y": "19"
            },
            {
                "id": 3938083,
                "fixture_id": 18795544,
                "period_id": 4644037,
                "timer": "3:28",
                "x": "8",
                "y": "77"
            }
        ]
    },

最高的id是3939282。
在下面的帖子中,我注意到可以对JSON字符串的一部分中的项目进行计数:
size of an array excel - json vba parser
如果我把变量计数改为变量最大,它也能工作。
如果我尝试以下面的方式在自己的Excel VBA代码中实现此方法,则会在第二行(以Set myvar开头)出现错误。

Dim myvar As Object
    Set myvar = item("ball_coordinates")("id")
    Debug.Print myvar.Count
    Debug.Print WorksheetFunction.Max(myvar)

错误为:运行时错误5:无效的过程调用或参数。
我在这个工作簿中激活了JsonConverter代码,它运行良好。
我想原因是id分散在所有元素中,而不是像其他帖子那样在一个元素中。
有什么办法可以克服吗?
多谢了!

    • 编辑:**

我提出这个问题的原因是我试图提高我的代码的速度。如果我使用下面的代码与迭代它需要9秒来处理30k球坐标。

highest_bal_id = 0
bal_timer = "NA"
bal_x = "NA"
bal_y = "NA"

For Each bal In item("ball_coordinates")

    bal_id = bal("id")
    If bal_id > highest_bal_id Then
    
        bal_timer = bal("timer")
        bal_x = bal("x")
        bal_y = bal("y")
        highest_bal_id = bal_id
    
    End If
    
Next
    • 编辑2:**

我也尝试了下面的替代代码,看看这是否更快。虽然我没有成功地访问基于highest_ball_id的item("ball_coordinates")("id")。我不知道是否有可能访问它作为字典或集合与基于highest_ball_id的键。

teller = 1

For Each bal In item("ball_coordinates")

    temp_array(teller) = bal("id")
    teller = teller + 1
    
Next

highest_ball_id = WorksheetFunction.Max(temp_array)

Debug.Print item("ball_coordinates")("id"); highest_ball_id
    • 编辑3**

json数据字符串是从一个更大的字符串嵌套而来的。数据来自一个API,使用以下代码生成:

Dim http As Object, json As Object, i As Integer, item As Object
Dim APIString As String
Set http = CreateObject("MSXML2.XMLHTTP")
APIString = "https://api.com/livescores/inplay?api_token=__&include=periods;scores;participants;ballCoordinates"
    http.Open "GET", APIString, True
    http.send

Set json = ParseJson(http.responseText)

For Each item In json("data")

    'read every item for periods, scores, participants, ballCoordinates

Next
pgky5nke

pgky5nke1#

试试这样的...

Dim json As Object
Set json = JsonConverter.ParseJson("{""ball_coordinates"":[ . . . ]}")

Dim ballCoordinatesCollection As Object
Set ballCoordinatesCollection = json("ball_coordinates")

Dim collectionItem As Object
Dim id As Long
Dim maxID As Long

maxID = 0
For Each collectionItem In ballCoordinatesCollection
    id = collectionItem("id")
    If id > maxID Then
        maxID = id
    End If
Next collectionItem

MsgBox "Maximum ID is " & maxID
oo7oh9g9

oo7oh9g92#

通常用正则表达式自己解析json是不好的做法,但是对于一个简单的情况,速度是最重要的,那么这是一个选择。这应该需要大约0.2秒。

Sub MaxID()

    Dim fso, ts, regex, m, s As String, t0 As Single
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' load json from text file
    'Set ts = fso.OpenTextFile("30000.json")
    's = ts.ReadAll
    'ts.Close

    ' or load from api
    ' add http code here
    s = http.responseText
    t0 = Timer
    
    ' create regex
    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "\""id\"": *(\d+)," ' "id": 3938083,
        Set m = .Execute(s)
    End With
    
    ' fill array
    Dim ar, i As Long
    ReDim ar(1 To m.Count) As Long
    For i = 1 To m.Count
        ar(i) = m(i - 1).submatches(0)
    Next
    
    ' result
    MsgBox Application.Max(ar), vbInformation, Format(Timer - t0, "0.0 secs")
      
End Sub

相关问题