纯vba代码解析json格式数据

我是来讨说法的

人狠话不多，直接说用法！！！
此方法是外国友人原创的，纯vba/vb代码解析，出处在模块里有体现。
前言：
JSON(JavaScript Object Notation) 是一种轻量级的数据交换格式。易于人阅读和编写。同时也易于机器解析和生成。它基于JavaScript Programming Language, Standard ECMA-262 3rd Edition - December 1999的一个子集。在 JS 语言中，一切都是对象。因此，任何支持的类型都可以通过 JSON 来表示，例如字符串、数字、对象、数组等。但是对象和数组是比较特殊且常用的两种类型：

• 对象表示为键值对
  
• 数据由逗号分隔
  
• 花括号保存对象
  
• 方括号保存数组
  
  

如{"a": "Json","b":["1","2"]}，其中"a"是键，它的值是"Json"，"b"也是键，它的值是["1","2"]
看到这里，你是不是有点时曾相识的感觉？
对，你的感觉没错，它跟vba里面的字典（Dictionary）一模一样！！


言归正传：
既然跟vba的字典（Dictionary）一样，那就可以转化为字典来使用吧。（如果不懂vba的字典的用法，请自行不课）
国外友人真就这么做了，这位友人将json中用花括号包围起来的内容转化为字典（Dictionary），将方括号包围起来的内容转化为集合（Collection，集合跟数组的用法类似）
画重点
花括号 → vba的字典对象（Dictionary）
方括号 → vba的集合对象（Collection）
以下讲解的内容附件中都有
先分析我们要解析的json字符串，到json.cn格式化一下

我们发现除了resultList这个key对应的的值是集合（因为是方括号包围的）以外，其他都是字典。
那么，假如我们要获取orderAnalysisTime这个key对应的值2018-11-27T11:38:24怎么写呢
首先用我们需要将json字符串转化成vba可识别的对象

1. Dim jsonStr As String
   
2. Dim jsonObject As New JSON
   
3. 
   
4. 'json字符串
   
5. jsonStr = Range("A1").Value
   
6. '先将json字符串转化为vba的对象
   
7. Set dict = jsonObject.parse(jsonStr)

复制代码

此时dict就是vba的一个对象(字典对象，因为开头是用花括号包围的)，而我们要的值却在dict字典对象的key为map所对应的值里面，而map所对应的值也是一个字典对象，那么字典对象是怎么根据key访问对应的value，我们就依葫芦画瓢：

1. Dim jsonStr As String
   
2. Dim jsonObject As New JSON
   
3. 
   
4. 'json字符串
   
5. jsonStr = Range("A1").Value
   
6. '先将json字符串转化为vba的对象
   
7. Set dict = jsonObject.parse(jsonStr)
   
8. '跟访问字典的方式一样，访问map对应值
   
9. Set map_dict = dict("map")
   
10. '输入orderAnalysisTime对应的值
    
11. Debug.Print "orderAnalysisTime的值：" & map_dict("orderAnalysisTime")

复制代码

说到这里，相信很多人已经明白了吧

然后再说说json中方括号里面的内容怎么获取地。上面已经说了，方括号对应的是vba的集合，而集合与数组类似，通过下标访问，那么

1. Dim jsonStr As String
   
2. Dim jsonObject As New JSON
   
3. 
   
4. 'json字符串
   
5. jsonStr = Range("A1").Value
   
6. '先将json字符串转化为vba的对象
   
7. Set dict = jsonObject.parse(jsonStr)
   
8. '跟访问字典的方式一样，访问map对应值
   
9. Set map_dict = dict("map")
   
10. '输入orderAnalysisTime对应的值
    
11. Debug.Print "orderAnalysisTime的值：" & map_dict("orderAnalysisTime")
    
12. '访问resultList对应的数组，在vba中它被转化成了集合Collection
    
13. Set resultList_coll = map_dict("resultList")
    
14. '输出集合的长度
    
15. Debug.Print "resultList_coll集合的长度：" & resultList_coll.Count()

复制代码

现在再看看这个集合里面是什么？是花括号包围的数据！对又用上面的方法解析就OK啦

1. Sub test()
   
2. Dim jsonStr As String
   
3. Dim jsonObject As New JSON
   
4. 
   
5. 'json字符串
   
6. jsonStr = Range("A1").Value
   
7. '先将json字符串转化为vba的对象
   
8. Set dict = jsonObject.parse(jsonStr)
   
9. '跟访问字典的方式一样，访问map对应值
   
10. Set map_dict = dict("map")
    
11. '输入orderAnalysisTime对应的值
    
12. Debug.Print "orderAnalysisTime的值：" & map_dict("orderAnalysisTime")
    
13. '访问resultList对应的数组，在vba中它被转化成了集合Collection
    
14. Set resultList_coll = map_dict("resultList")
    
15. '输出集合的长度
    
16. Debug.Print "resultList_coll集合的长度：" & resultList_coll.Count()
    
17. '上面的集合长度为1，只包含一个字典对象
    
18. Set s_dict = resultList_coll(1)
    
19. '遍历字典
    
20. Debug.Print "*****************************************************"
    
21. Debug.Print "父对象的key", "子对象的key", "子对象的Value"
    
22. For Each k_str In s_dict.keys()
    
23.     Set temp_dict = s_dict(k_str) 's_dict(k_str)'本身就是一个字典
    
24.     For Each k In temp_dict.keys()
    
25.         Debug.Print k_str, k, temp_dict(k)
    
26.     Next
    
27. Next
    
28. End Sub

复制代码

此文如果对你又用，请赏个小花花吧，谢谢！




补充内容 (2019-4-29 15:04):
据网友反映，64位office报错，解决方法如下：
Private Function UnsignedAdd(StPart As Long, Incr As Long) As Long
变为：
Private Function UnsignedAdd(Start As LongPtr, Incr As Long) As LongPtr

补充内容 (2019-4-29 15:35):
通用版附件在12楼

liucqa

支持64位吗？

chis3

留個名
對於複雜的json 很多時候解不了

我是来讨说法的

liucqa 发表于 2018-12-22 00:20
支持64位吗？

据铁友回应，64位提示strpar报类型不匹配，还没来得及修复

xiaotutu6000

请问，楼主。这个strpar 类型不匹配，要怎么处理？我现在使用这个遇到了问题。在64位系统上。

lion21369

写得很好,支持!!!!!!!!

shuxiang850129

学习中，谢谢分享！

我是来讨说法的

liucqa 发表于 2018-12-22 00:20
支持64位吗？

支持
Private Function UnsignedAdd(StPart As Long, Incr As Long) As Long
变为：
Private Function UnsignedAdd(Start As LongPtr, Incr As Long) As LongPtr

liucqa

我是来讨说法的 发表于 2019-4-29 15:06
支持
Private Function UnsignedAdd(StPart As Long, Incr As Long) As Long
变为：

那你改一下代码啊，加个VBA7和Win64条件编译

我是来讨说法的

xiaotutu6000 发表于 2019-2-6 01:30
请问，楼主。这个strpar 类型不匹配，要怎么处理？我现在使用这个遇到了问题。在64位系统上。

64位office报错，解决方法如下：
Private Function UnsignedAdd(StPart As Long, Incr As Long) As Long
变为：
Private Function UnsignedAdd(Start As LongPtr, Incr As Long) As LongPtr