Excel VBA如何從JSON對列表中查找最小值？

Question

   URL = "https://xxxx.xxxxxxxxxx.com/api/getPrice.php"
   objHTTP.Open "POST", URL, False
   objHTTP.setRequestHeader "Content-type", "application/json"
   objHTTP.send JSONStringSend
   result = objHTTP.responseText    
   Set Json = JsonConverter.ParseJson(result)
   methodcount = Json("shipping").Count

上面是獲取響應的代碼。

以下是我得到的結果。

{
               "shipping":[
           {
           "name":"Speedpost via Singapore Post",
           "price":27.6,
           "delivery":"15-25 days"
           },
           {
           "name":"Registered Airmail via Swiss Post",
           "price":5.89,
           "delivery":"10 - 25 Days delivery"
           },
           {
           "name":"Unregistered Airmail via Singapore Post",
           "price":2.27,
           "delivery":"12 - 45 Days delivery"
           },
           {
           "name":"Registered Airmail via SF ",
           "price":4.36,
           "delivery":"10 - 15 business Days delivery"
           },
           {
           "name":"HK DHL",
           "price":37.09,
           "delivery":"4 - 7 Days delivery"
           }
           ]
}

通過API調用將運輸方法列表作為http對象。 我想選擇最便宜的方法，然后僅將價格寫入單元格中。

如何從所有鍵/值對中找到最小值？

Answer 1

請參閱評論中的說明

Set Json = JsonConverter.ParseJson(result)
Set shipping = Json("shipping") 
methodcount = shipping.Count
targetCell.Value=getMinPrice(shipping) 'Display the min Price in the cell you want.

這是獲得最低價格的功能

Public Function getMinPrice(shipping as Variant)As Double 'Variant is nothing but a convenient VBA way to specify that the shipping argument could be of any type. 
    getMinPrice=10000000.0        ' Set initial minPrice
                                  'Iterate through each record in shipping list. For each loop rec is assigned the new set of price list record. The loop is run till all records are exhausted.
    For Each rec In shipping      'rec is nothing but a variable like i=0, So you can replace rec here and in the following statements with whatever you like
                                  'You could avoid using 'Val' function here, I put it as a precautionary measure
        If getMinPrice > Val(rec("price")) Then 'Check if new price is less the minimum we already have
            getMinPrice = Val(rec("price"))     'Set the new minimum Price.
        End If
    Next
End Function

Answer 2

這不是基於json api的解決方案。 只需引用它（如果您的數據全部如上）。

Sub test()
    Dim s As String
    s = Range("a1") '<~~  if your json text in range("a1") else enter json instead
    's = json.text
    JsonToArray Range("b1"), s, "price"
    JsonToArray Range("c1"), s, "name"
    JsonToArray Range("d1"), s, "delivery"
    JsonToArrayMin Range("a4"), s, "price"
End Sub
Sub test2()
    Dim s As String
    s = Range("a1") '<~~  if your json text in range("a1") else enter json instead
    JsonToArrayMin Range("a4"), s, "price"
End Sub
Sub JsonToArray(rng As Range, Json As String, Item As String)
    Dim vR() As Variant, vSplit, v
    Dim n As Long, i As Long
    Item = Item & Chr(34) & ":"
    vSplit = Split(Json, Item)
    For i = 1 To UBound(vSplit)
        v = vSplit(i)
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = Split(v, ",")(0)
        vR(n) = Replace(vR(n), Chr(34), "")
        vR(n) = Replace(vR(n), ":", "")
        vR(n) = Replace(vR(n), "}", "")
        vR(n) = Replace(vR(n), "]", "")

    Next i
    If n > 0 Then
        rng.Resize(n) = WorksheetFunction.Transpose(vR)
    End If
End Sub

Sub JsonToArrayMin(rng As Range, Json As String, Item As String)
    Dim vR() As Variant, vSplit, v
    Dim n As Long, i As Long
    Item = Item & Chr(34) & ":"
    vSplit = Split(Json, Item)
    For i = 1 To UBound(vSplit)
        v = vSplit(i)
        n = n + 1
        ReDim Preserve vR(1 To n)
        vR(n) = Split(v, ",")(0)
        vR(n) = Replace(vR(n), Chr(34), "")
        vR(n) = Replace(vR(n), ":", "")
        vR(n) = Replace(vR(n), "}", "")
        vR(n) = Replace(vR(n), "]", "")
        vR(n) = Val(vR(n))
    Next i
    If n > 0 Then
        rng = WorksheetFunction.Min(vR)
    End If
End Sub