从 MS Access 解析 VBA 中的 JSON（美国 BLS），更新

Question

所以，我之前问过一个问题，已经成功回答（这里：Parsing JSON (US BLS) in VBA from MS Access）

我得到的与原始问题不同的新回复是我添加了一个捕获计算的请求。我尝试添加为集合和脚本字典（如脚注），但我看到格式并不完全相同，因此我认为当我尝试收集 1、3、6 和 12 个月的更改时它会导致 null。我希望得到一些帮助，以了解如何在以下响应中捕捉这些变化：

{
    "status":"REQUEST_SUCCEEDED",
    "responseTime":64,
    "message":["BLS does not produce net change calculations for Series WPU381103"],
    "Results":
    { 
        "series": 
        [
            {
                "seriesID":"WPU381103",
                "data":
                [
                    {
                        "year":"2014",
                        "period":"M12",
                        "periodName":"December",
                        "value":"98.9",
                        "footnotes":
                        [
                            {
                                "code":"P",
                                "text":"Preliminary. All indexes are subject to revision four months after original publication."
                            }
                        ], 
                        "calculations":
                        {
                            "net_changes":{},
                            "pct_changes":
                            {
                                "1":"0.0",
                                "3":"0.1",
                                "6":"0.0",
                                "12":"-0.7"
                            }
                        }
                    }, 
                    {
                        "year":"2014",
                        "period":"M11",
                        "periodName":"November",
                        "value":"98.9",
                        "footnotes":
                        [
                            {
                                "code":"P",
                                "text":"Preliminary. All indexes are subject to revision four months after original publication."
                            }
                        ],
                        "calculations":
                        {
                            "net_changes":{},
                            "pct_changes":
                            {
                                "1":"0.1",
                                "3":"-0.4",
                                "6":"0.0",
                                "12":"-0.7"
                            }
                        }
                    },...

您会注意到现在有一​​部分表示计算，并通过净变化和百分比变化来分隔值。我正在尝试获取“1”、“3”、“6”和“12”数据项中的百分比变化。

这是我当前的代码，它没有找到计算但捕获所有其他数据：

response = http.responseText
jsonSource = response

I = 0

Dim jsonData As Scripting.Dictionary
Set jsonData = JSON.parse(jsonSource)
Dim responseTime As String
responseTime = jsonData("responseTime")

Dim results As Scripting.Dictionary
  On Error Resume Next
Set results = jsonData("Results")

Dim series As Collection
On Error Resume Next
Set series = results("series")

Dim seriesItem As Scripting.Dictionary
For Each seriesItem In series
    Dim seriesId As String
    seriesId = seriesItem("seriesID")


    Dim Data As Collection
    Set Data = seriesItem("data")

    Dim dataItem As Scripting.Dictionary
    For Each dataItem In Data
        Dim Year As String
        Year = dataItem("year")
I = 1 + I
        Dim Period As String
        Period = dataItem("period")

        Dim periodName As String
        periodName = dataItem("periodName")

        Dim Value As String
        Value = dataItem("value")

        Dim footnotes As Collection
        Set footnotes = dataItem("footnotes")

        Dim footnotesItem As Scripting.Dictionary
        For Each footnotesItem In footnotes
            Dim Code As String
            Code = footnotesItem("code")

            Dim text As String
            text = footnotesItem("text")

        Next footnotesItem
    Next dataItem
Next seriesItem

Answer 1

非常直接。请记住，JSON 模块将 JavaScript 数组实现为集合，将对象实现为 Scripting.Dictionary 实例。

在您的上下文中，[..].calculations、[..].calculations.net_changes 和 [..].calculations.pct_changes 都是对象，因此它们都被转换为 Dictionary 对象。

因此，在您的代码中，在 For Each footnotesItem In footnotes: [..]: Next footnotesItem 块之后（因此，在 Next dataItem 行的上方和之前），您可以添加以下行：

Dim calculations As Scripting.Dictionary
Dim sIndent As String
Dim calcNetChanges As Scripting.Dictionary
Dim calcPctChanges As Scripting.Dictionary
Dim varItem As Variant
        Set calculations = dataItem("calculations")
        sIndent = String(4, " ")
        Set calcNetChanges = calculations("net_changes")
        Debug.Print Year & ", " & Period & " (" & periodName & ") - Net Changes:"
        If calcNetChanges.Count > 0 Then
            For Each varItem In calcNetChanges.keys
                Debug.Print sIndent & CStr(varItem) & ": " & calcNetChanges.Item(varItem)
            Next varItem
        Else
            Debug.Print sIndent & "(none)"
        End If
        Set calcPctChanges = calculations("pct_changes")
        Debug.Print Year & ", " & Period & " (" & periodName & ") - Pct Changes:"
        If calcPctChanges.Count > 0 Then
            For Each varItem In calcPctChanges.keys
                Debug.Print sIndent & CStr(varItem) & ": " & calcPctChanges.Item(varItem)
            Next varItem
        Else
            Debug.Print sIndent & "(none)"
        End If

在提供 json 数据的情况下，应该会输出如下内容：

2014, M12 (December) - Net Changes:
    (none)
2014, M12 (December) - Pct Changes:
    1: 0.0
    3: 0.1
    6: 0.0
    12: -0.7
2014, M11 (November) - Net Changes:
    (none)
2014, M11 (November) - Pct Changes:
    1: 0.1
    3: -0.4
    6: 0.0
    12: -0.7

如果你想通过它们的键直接访问calculations.net_changes 和calculations.pct_changes 的项目（预先知道），你可以分别替换这两个For Each varItem 块：

If calcNetChanges.Exists("1") Then Debug.Print "1: " & calcNetChanges.Item("1")
If calcNetChanges.Exists("3") Then Debug.Print "3: " & calcNetChanges.Item("3")
If calcNetChanges.Exists("6") Then Debug.Print "6: " & calcNetChanges.Item("6")
If calcNetChanges.Exists("12") Then Debug.Print "12: " & calcNetChanges.Item("12")

[..]

If calcPctChanges.Exists("1") Then Debug.Print "1: " & calcPctChanges.Item("1")
If calcPctChanges.Exists("3") Then Debug.Print "3: " & calcPctChanges.Item("3")
If calcPctChanges.Exists("6") Then Debug.Print "6: " & calcPctChanges.Item("6")
If calcPctChanges.Exists("12") Then Debug.Print "12: " & calcPctChanges.Item("12")

最后，您应该注意，在您作为示例提供的 json 数据中，百分比（即 [..].calculations.net_changes 和 [..].calculations.pct_changes 的项目值）作为 字符串 提供，因此您可能希望使用 Val() 转换 Double（或 Single）数据中的那些，以对它们执行数学或其他数值运算，例如：

Dim pctChange_1 As Double, pctChange_3 As Double
Dim pctChange_6 As Double, pctChange_12 As Double
    pctChange_1 = 0#
    pctChange_3 = 0#
    pctChange_6 = 0#
    pctChange_12 = 0#
    If calcPctChanges.Exists("1") Then pctChange_1 = CDbl(Val(calcPctChanges.Item("1")))
    If calcPctChanges.Exists("3") Then pctChange_3 = CDbl(Val(calcPctChanges.Item("3")))
    If calcPctChanges.Exists("6") Then pctChange_6 = CDbl(Val(calcPctChanges.Item("6")))
    If calcPctChanges.Exists("12") Then pctChange_12 = CDbl(Val(calcPctChanges.Item("12")))

Answer 2

将计算声明为Scripting.Dictionary，并将其pct-changes声明为Scripting.Dictionary。在 脚注 的代码之后附加以下代码 sn-p。高温

Dim calculations As Scripting.Dictionary
Set calculations = dataItem("calculations")

Dim pct_changes As Scripting.Dictionary
Set pct_changes = calculations("pct_changes")

Dim pct_change As Variant
For Each pct_change In pct_changes
    Debug.Print pct_change & ":" & pct_changes(pct_change)
Next pct_change

Debug.Print pct_change & ":" & pct_changes(pct_change) 为第一个计算集生成以下结果：

1:0.0
3:0.1
6:0.0
12:-0.7