如何用Excel VBA解析JSON数据（这个对我真的好难！）

hai167

coby001 发表于 2015-9-6 15:00

Sub bluejson()    '方法二

    Dim aa, y As Object, x As Object

    Dim name, id   ' 这 ...

CallByName是什么来的？VBA不识别。

zhangjimfu

coby001 发表于 2015-9-6 15:00

Sub bluejson()    '方法二

    Dim aa, y As Object, x As Object

    Dim name, id   ' 这 ...

感谢大侠！代码执行到With CallByName(y, "1", VbGet)时出错，不知道是什么原因？

coby001

难道高版本的VBA 屏蔽了此函数？

onlycxb

zhangjimfu 发表于 2015-9-6 16:55
大侠，你的代码我测试过了，这就是我想要的，非常感谢！
另外，有两个不情之请：
1、转换过的数据能否 ...

这是通过js代码处理数据，具体对jscript语法进行了解。

coby001

excel 2003 运行正常啊~

hai167

zhangjimfu 发表于 2015-9-6 16:55
大侠，你的代码我测试过了，这就是我想要的，非常感谢！
另外，有两个不情之请：
1、转换过的数据能否 ...

Sub bluejson()                                             '方法二
    Dim aa, y As Object
    Set x = CreateObject("ScriptControl"): x.Language = "JScript"
    aa = Sheets("Sheet1").Range("A1").Value
    'MsgBox x.eval("var a=" & aa & ";s='';for(x in a){ for(y in a[x]){s+=a[x][y]+'\t';}s+='\r'}")
    t1 = Split(x.eval("var a=" & aa & ";s='';for(x in a){ for(y in a[x]){s+=a[x][y]+'|'+'\t';}s+='\r'}"), Chr(13))
    For i = 0 To UBound(t1)
        If t1(i) <> "" Then
           t2 = Split(t1(i), "|")
           Lrow = Range("A65536").End(xlUp).Row + 1
           Range("A" & Lrow).Resize(1, UBound(t2) + 1) = t2
        End If
    Next
End Sub

我在'onlycxb代码上加上这些代码可以转成你要的格式。

coby001

zhangjimfu 发表于 2015-9-6 16:58
感谢大侠！代码执行到With CallByName(y, "1", VbGet)时出错，不知道是什么原因？

可能是 aa=jsonString 没赋值正确

我用的是你在1楼的 那个json 字串

crazy0qwer

zhangjimfu 发表于 2015-9-6 16:47
兄弟，我真的有点感动了，你我非亲非故，写这么长的代码一定花了你不少时间和精力，不管能不能解决问题， ...

50行代码不算什么，花不了多少时间。
这段代码应该会比你的方法二效率。

hai167

coby001 发表于 2015-9-6 17:23
可能是 aa=jsonString 没赋值正确

我用的是你在1楼的 那个json 字串

With CallByName(y, "1", VbGet)

他的数据行数不固定，"1"这个变量可以通过循环吗？而不是指定某个固定值。

onlycxb

1. Sub bluejson()                                             '方法二
   
2.     Dim aa, y As Object, arr, x
   
3.     Set x = CreateObject("ScriptControl"): x.Language = "JScript"
   
4.     aa = Sheets("Sheet1").Range("A1").Value
   
5.     arr = Split(x.eval("var a=" & aa & ";s='';for(x in a){ for(y in a[x]){s+=a[x][y]+'\t';}s+='\r'}"), vbCr)
   
6.     With Sheet1
   
7.     .[a10].Resize(UBound(arr, 1), 1) = arr
   
8.     [a10].Resize(UBound(arr, 1), 1).TextToColumns Destination:=.[a10]
   
9.     End With
   
10. End Sub

复制代码