如何使用Excel vba从json字符串的json对列表中查找最大值？

我是VBA和编码方面的新手。 假设我有一个json字符串，如下所示：

jsonstr = [{"id":"BGFV:US","dateTimeRanges":{},"price":[{"date":"2019-08-07","value":2.03},{"date":"2019-08-08","value":1.98},{"date":"2019-08-09","value":1.98},{"date":"2019-08-12","value":1.9100000000000001},{"date":"2019-08-13","value":1.9100000000000001},{"date":"2019-08-14","value":1.8},{"date":"2019-08-15","value":1.7},{"date":"2019-08-16","value":1.77},{"date":"2019-08-19","value":1.8399999999999999},{"date":"2019-08-20","value":1.8199999999999998},{"date":"2019-08-21","value":1.9100000000000001},{"date":"2019-08-22","value":1.97},{"date":"2019-08-23","value":1.95},{"date":"2019-08-26","value":1.96},{"date":"2019-08-27","value":2.07},{"date":"2019-08-28","value":1.87},{"date":"2019-08-29","value":1.87},{"date":"2019-08-30","value":1.79},{"date":"2019-09-03","value":1.7},{"date":"2019-09-04","value":1.71},{"date":"2019-09-05","value":1.79},{"date":"2019-09-06","value":1.8599999999999999}],"timeZoneOffset":-4,"nyTradeStartTime":"09:30:00.000","nyTradeEndTime":"16:30:00.000","priceMinDecimals":2,"lastUpdateDate":"2019-09-06","lastPrice":1.86}]

我试图从上面的json字符串中获取表示股票价格“最高值”的数据

但是，我只希望在excel工作表的第2行中显示“value”变量的最高值

我编写了以下宏： 请参见以上代码部分

Sub getData()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim n As Integer
    Dim lastrow As Long
    Dim i As Double

    Set wb = ActiveWorkbook
    Set ws = Sheets("Sheet1")
    ws.Activate

    'Last row find
    lastrow = ws.Cells(rows.Count, "A").End(xlUp).row

    Set rng = ws.Range("A2:A" & lastrow)

    'Clear Prior Prices
    ws.Range("B2:B" & lastrow).ClearContents

    n = 2

    'Get Symbols list
    For Each Symbol In rng

        Dim httpObject As Object

        Set httpObject = CreateObject("MSXML2.XMLHTTP")

        Dim sURL As String

        sURL = "https://www.bloomberg.com/markets/api/bulk-time-series/price/" & Symbol & "%3AUS?timeFrame=1_MONTH"

        Dim sRequest As String

        sRequest = sURL

        httpObject.Open "GET", sRequest, False

        httpObject.send

        Dim sGetResult As String

        sGetResult = httpObject.responseText

        Dim oJSON As Variant

        Set oJSON = JsonConverter.ParseJson(sGetResult)

        On Error Resume Next

        For Each item In oJSON(price)

            ws.Cells(n, 2).Value = item("value")

        Next item

        n = n + 1
    Next Symbol

    MsgBox ("Data is downloaded.")
End Sub

当我运行这段代码时，它不会给出任何错误和输出。 我想我错过了一些基本的东西，但仍然找不到

任何想法都将不胜感激！

---

提前谢谢

您可以使用一个函数循环所有价格并进行比较；返回找到的最高值。我不想循环范围本身，而是将值转移到数组中，并循环它，因为它更快。去掉变量的匈牙利符号。另外，在循环外部创建

http

变量一次

Option Explicit
Public Sub GetData()
    Dim wb As Workbook, ws As Worksheet, rng As Range, symbols()
    Dim lastRow As Long, n As Long, http As Object

    Set http = CreateObject("MSXML2.XMLHTTP")
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.rows.Count, "A").End(xlUp).row
    Set rng = ws.Range("A2:A" & lastRow)
    ws.Range("C2:C" & lastRow).ClearContents
    symbols = Application.Transpose(rng.Value) 'rng.Value creates 2D array. Transpose converts to 1D.

    Dim response As String, json As Object

    For n = LBound(symbols) To UBound(symbols)
        With http
            .Open "GET", "https://www.bloomberg.com/markets/api/bulk-time-series/price/" & symbols(n) & "%3AUS?timeFrame=1_MONTH", False
            .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'mitigate for caching between runs
            .send
            response = .responseText
        End With
        Set json = JsonConverter.ParseJson(response)
        ws.Cells(n + 1, 3).Value = GetMaxPrice(json)
        Set json = Nothing
    Next

    MsgBox "Data is downloaded."
End Sub

Public Function GetMaxPrice(ByVal json As Object) As Variant
    Dim prices As Object, price As Object, maxPrice As Double
    On Error GoTo errhand
    Set prices = json(1)("price")
    For Each price In prices
        If price("value") > maxPrice Then maxPrice = price("value")
    Next
    GetMaxPrice = maxPrice
    Exit Function
errhand:
    GetMaxPrice = CVErr(xlErrNA)
End Function

---

阅读（以便根据您的要求定制错误处理）：

---

编辑：

选项显式
公共子GetData（）
将wb作为工作簿，ws作为工作表，rng作为范围，符号（）
Dim lastRow为长，n为长，http为对象
设置http=CreateObject（“MSXML2.XMLHTTP”）
设置wb=ThisWorkbook
设置ws=wb.工作表（“表1”）
lastRow=ws.Cells（ws.Rows.Count，“A”）.End（xlUp）.Row
设置rng=ws.Range（“A2:A”和lastRow）
ws.Range（“C2:C”和lastRow）.ClearContents
符号=应用程序.Transpose（rng.Value）'rng.Value创建2D数组。转置转换为1D。
Dim响应作为字符串，json作为对象，arr（）
对于n=LBound（符号）到UBound（符号）
多芬特
使用http
.打开“获取”https://www.bloomberg.com/markets/api/bulk-time-series/price/符号（n）和“%3US？时间范围=1个月”，错误（&n）
.setrequestheader“如果自”“Sat，2000年1月1日00:00:00 GMT”“修改”，缓解运行之间的缓存问题
.setrequestheader“用户代理”、“Mozilla/5.0”
.发送
response=.responseText
以
Set json=JsonConverter.ParseJson（响应）
arr=GetPrices（json）
ws.Cells（n+1,2）.Value=arr（0）
ws.Cells（n+1,3）.Value=arr（1）
ws.Cells（n+1,4）.Value=arr（2）
设置json=Nothing
下一个
MsgBox“数据已下载。”
端接头
作为变量的公共函数GetPrices（ByVal json作为对象）
将Dim price作为Object，price作为Object，maxPrice作为Double，minPrice作为Double，lastPrice作为Double
在错误上走错
设定价格=json（1）（“价格”）
最小价格=价格（1）（“价值”）：最大价格=最小价格
价格中的每一个价格
如果价格（“价值”）>maxPrice，则maxPrice=价格（“价值”）
如果价格（“价值”）小于最低价格，则最低价格=价格（“价值”）
下一个
lastPrice=json（1）（“lastPrice”）
GetPrices=数组（lastPrice、maxPrice、minPrice）
退出功能
错误：
GetPrices=Array（CVErr（xlErrNA）、CVErr（xlErrNA）、CVErr（xlErrNA））
端函数

是的，您的代码有效。但它显示错误，即运行时错误“10001”：解析JSON时出错：错误的请求^变量显示在我的excel工作表的第2行和第3列。那么，我将如何显示它？嗨，Rasmita！问题1）您可以通过共享60个符号，我会看一看。似乎您有一个需要处理的错误，并且您有我在答案的阅读部分中包含的链接。2）如果您有60个val，我不理解r2c3您正在检索的ues不能全部写入单个单元格。请您澄清一下。假设第一个符号在A2中，最高价格将流向何处？那么A3中的下一个符号的价格将流向何处？……实际上，第一个符号的最高价格在A2中，将流向C2，第二个符号在A3中的值将流向C3，A4将流向C4。。。。。。。。…A60会变成C60的好的我需要你的帮助。

Option Explicit

Public Sub GetData()
    Dim wb As Workbook, ws As Worksheet, rng As Range, symbols()
    Dim lastRow As Long, n As Long, http As Object

    Set http = CreateObject("MSXML2.XMLHTTP")
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set rng = ws.Range("A2:A" & lastRow)
    ws.Range("C2:C" & lastRow).ClearContents
    symbols = Application.Transpose(rng.Value) 'rng.Value creates 2D array. Transpose converts to 1D.

    Dim response As String, json As Object, arr()

    For n = LBound(symbols) To UBound(symbols)
        DoEvents
        With http
            .Open "GET", "https://www.bloomberg.com/markets/api/bulk-time-series/price/" & symbols(n) & "%3AUS?timeFrame=1_MONTH", False
            .setrequestheader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT" 'mitigate for caching between runs
            .setrequestheader "User-Agent", "Mozilla/5.0"
            .send
            response = .responseText
        End With
        Set json = JsonConverter.ParseJson(response)
        arr = GetPrices(json)
        ws.Cells(n + 1, 2).Value = arr(0)
        ws.Cells(n + 1, 3).Value = arr(1)
        ws.Cells(n + 1, 4).Value = arr(2)
        Set json = Nothing
    Next

    MsgBox "Data is downloaded."
End Sub

Public Function GetPrices(ByVal json As Object) As Variant
    Dim prices As Object, price As Object, maxPrice As Double, minPrice As Double, lastPrice As Double
    On Error GoTo errhand
    Set prices = json(1)("price")
    minPrice = prices(1)("value"): maxPrice = minPrice
    For Each price In prices
        If price("value") > maxPrice Then maxPrice = price("value")
        If price("value") < minPrice Then minPrice = price("value")
    Next
    lastPrice = json(1)("lastPrice")
    GetPrices = Array(lastPrice, maxPrice, minPrice)
    Exit Function
errhand:
    GetPrices = Array(CVErr(xlErrNA), CVErr(xlErrNA), CVErr(xlErrNA))
End Function