将2个或更多嵌套字典合并为1，并按照自定义顺序排列项目

我是字典新手。 我从一个外部网站提取数据，输出一个JSONstring，其中包含我使用这里find的VBA-JSON代码parsing的Initiative Level数据。 这个JSONparsing器输出一个包含嵌套字典和集合的JSON字典对象。

{ "respCode": 200, "respMessage": "OK", "response": [ { "INIT_ID": 1234567, "INIT_NAME": "SOME INIT NAME", "CATE": "PERFUMED WATER", "CTRY": "GB", "OPEN_DATE": "2016-02-10 00:00:00", "ITEMS": [ { "ITEM_ID": "44556677", "ITEM_DSCR": "ABC CO, PERFUMED WATER,CARBONATED,AMBIENT,,,,CAFFEINE,PLASTIC,PACK,250ML" }, { "ITEM_ID": "45566778", "ITEM_DSCR": "ABC CO, PERFUMED WATER,CARBONATED,CRYSTAL,,,,CAFFEINE,GLASS,PACK,270ML" }, { "ITEM_ID": "46576879", "ITEM_DSCR": "ABC CO, PERFUMED WATER,NON-CARBONATED,AMBIENT,,,,NON-CAFFEINE,TETRA,PACK,275ML" } ] } ] } 

由于在这个计划中有3个项目，我必须再次从外部网站使用另外3个API调用拉这3个项目的属性数据 – 响应再次是JSONstring，我必须parsing使用VBA-JSON得到一个包含嵌套字典和集合的Dictionary对象，如下所示：

项目1：

 { "respCode": 200, "respMessage": "OK", "response": [ { "ITEM CODE": "44556677", "ITEM DESCRIPTION": "ABC CO, PERFUMED WATER,CARBONATED,AMBIENT,,,,CAFFEINE,PLASTIC,PACK,250ML", "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER - CARBONATED - CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "NO PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "KANE & ABEL" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "250ML" } ] } ] } 

项目2：

 { "respCode": 200, "respMessage": "OK", "response": [ { "ITEM CODE": "45566778", "ITEM DESCRIPTION": "ABC CO, PERFUMED WATER,CARBONATED,CRYSTAL,,,,CAFFEINE,GLASS,PACK,270ML", "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER, CRYSTAL - CARBONATED - CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "BEAUTY & BEAST" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "270ML" } ] } ] } 

项目3：

 { "respCode": 200, "respMessage": "OK", "response": [ { "ITEM CODE": "46576879", "ITEM DESCRIPTION": "ABC CO, PERFUMED WATER,NON-CARBONATED,AMBIENT,,,,NON-CAFFEINE,TETRA,PACK,275ML", "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER - NON-CARBONATED - NON-CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "NO PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "HENSEL & GRETEL" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "275ML" } ] } ] } 

我想要做的是：合并3项目词典与第一个倡议词典，使每个项目属性合并为每个项目指定的项目ID是这样的：

最终词典：

  { "respCode": 200, "respMessage": "OK", "response": [ { "INIT_ID": 1234567, "INIT_NAME": "SOME INIT NAME", "CATE": "PERFUMED WATER", "CTRY": "GB", "OPEN_DATE": "2016-02-10 00:00:00", "ITEMS": [ { "ITEM_ID": "44556677", "ITEM_DSCR": "ABC CO, PERFUMED WATER,CARBONATED,AMBIENT,,,,CAFFEINE,PLASTIC,PACK,250ML" "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER - CARBONATED - CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "NO PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "KANE & ABEL" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "250ML" } ] }, { "ITEM_ID": "45566778", "ITEM_DSCR": "ABC CO, PERFUMED WATER,CARBONATED,CRYSTAL,,,,CAFFEINE,GLASS,PACK,270ML" "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER, CRYSTAL - CARBONATED - CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "BEAUTY & BEAST" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "270ML" } ] }, { "ITEM_ID": "46576879", "ITEM_DSCR": "ABC CO, PERFUMED WATER,NON-CARBONATED,AMBIENT,,,,NON-CAFFEINE,TETRA,PACK,275ML" "ATTR DETAILS": [ { "ATTR ID": "25", "ATTR DESCRIPTION": "MOD_NAME", "ATTR_VAL ID": "22222222", "ATTR_VAL DESCRIPTION": "PERFUMED WATER - NON-CARBONATED - NON-CAFFIENE" }, { "ATTR ID": "45", "ATTR DESCRIPTION": "PROM ACTIVE", "ATTR_VAL ID": "44444444", "ATTR_VAL DESCRIPTION": "NO PROMO" }, { "ATTR ID": "38", "ATTR DESCRIPTION": "BRAND", "ATTR_VAL ID": "99999999", "ATTR_VAL DESCRIPTION": "HENSEL & GRETEL" }, { "ATTR ID": "51", "ATTR DESCRIPTION": "WEIGHT/VOLUME", "ATTR_VAL ID": "66666666", "ATTR_VAL DESCRIPTION": "275ML" } ] } ] } ] } 

最后，我想循环遍历最终字典，并在工作表上的3列中显示3个项目的详细信息，如下所示：

有人可以指导我如何做到这一点？

编辑：这是我能弄清楚…..但空白必须填写….

 Sub GetJSON() Dim XMLhttp As Object, oJSON As Object, oRTN As Object Dim URL1$ Dim arrItemIDs() As Variant Set oRTN = CreateObject("Scripting.Dictionary") oRTN.comparemode = vbTextCompare On Error GoTo ErrorHandler With ThisWorkbook Set wsMain = .Sheets("Main") Set wsOut = .Sheets("Output") URL = "http://11.27.141.15:8000/dev/getInit?" _ & "email=" & "[e-mail]" & "&country=" & "GB" & "&initid=" & "1234567" Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP") With XMLhttp .Open "GET", URL, False .setRequestHeader "Content-Type", "application/json" .setRequestHeader "Accept", "application/json" .Send If XMLhttp.ReadyState = 4 And XMLhttp.Status = 200 Then Set oJSON = ParseJson(XMLhttp.ResponseText) ' ******CODE TO BE WRITTEN TO COLLECT THE ITEM IDs IN AN ARRAY***** arrItemIDs = RecurseDictionary(oJSON) ' ***************************** For x = LBound(arrItemIDs) To UBound(arrItemIDs) URL = "http://11.27.141.15:8000/dev/getItemAttr?" _ & "email=" & "[e-mail]" & "&country=" & "GB" & "&itemid=" & arrItemIDs(x) Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP") With XMLhttp .Open "GET", URL, False .setRequestHeader "Content-Type", "application/json" .setRequestHeader "Accept", "application/json" .Send If XMLhttp.ReadyState = 4 And XMLhttp.Status = 200 Then Set oJSON = ParseJson(XMLhttp.ResponseText) ' ******CODE TO BE WRITTEN TO MERGE EACH ITEMS ATTRIBUTES JSON TO EARLIER INITIATIVES JSON ***** ' ***************************** End If End With Next x ' ******CODE TO BE WRITTEN TO DUMP MERGED ARRAY OR DIC ON TO SHEET***** i = 1 wsOut.Cells.ClearContents ' ***************************** End If End With End With 

Answer 1

这可能会让你开始：

 Sub Tester() Dim Json As Object, itm As Object, itemDetails, k, s As String Dim initiatives, initiative, items, itmId, details 'I'm storing the JSON on a worksheet for testing purposes... Set Json = JsonConverter.ParseJson(Sheet1.Range("A1").Value) Set initiatives = Json("response") '<< array of inititatives For Each initiative In initiatives 'Top-level info.... Debug.Print initiative("INIT_ID") Debug.Print initiative("INIT_NAME") Debug.Print initiative("CATE") 'etc.... 'list info on ITEMS (as aa collection) Set items = initiative("ITEMS") For Each itm In items 'itm is a Dictionary itmId = itm("ITEM_ID") Debug.Print "Item: " & itmId 'here's where you'd fetch the details using item id... Set itemDetails = JsonConverter.ParseJson(Sheet1.Range("B1").Value)("response")(1) Set details = itemDetails("ATTR DETAILS") Debug.Print details.Count Next itm Next End Sub 

我会把请求/响应/parsing分解为一个独立的函数：

 'return a parsed JSON object given a URL Function GetJsonObject(URL As String) Dim XMLhttp As Object, oJSON As Object Set XMLhttp = CreateObject("MSXML2.ServerXMLHTTP") With XMLhttp .Open "GET", URL, False .setRequestHeader "Content-Type", "application/json" .setRequestHeader "Accept", "application/json" .Send If .ReadyState = 4 And .Status = 200 Then Set oJSON = ParseJson(.ResponseText) End If End With Set GetJsonObject = oJSON End Function