JSON VBA 解析到 Excel [英] JSON VBA Parse to Excel
问题描述
我有一些 JSON 解析工作.我使用 VBA 解析来自我的网络服务器的 JSON 代码,将其写入 Excel 工作表中的单元格 A1.但我没有把它转换成其他单元格.
这是我的 JSON 示例:
{"@type":["IN.areaList.1","OII.list.1"],"@self":"/bereiche",列表":[{"@type":["IN.bereich.1"],"@self":"/1.1.Bereich.2.7",scha":假,"trlState":"",oiischa":假,readyTo1":假,readyTo2":假,"numberOfBypassedDevices":0,测试":"",测试活动":假,chModeActive":假,公司":[]}]}
这是我的 Sub,它适用于另一个示例:
Sub JsonToExcelExample()将 jsonText 调暗为字符串Dim jsonObject 作为对象将项目变暗为对象昏暗的我Dim ws As 工作表Set ws = Worksheets("远程")jsonText = ws.Cells(1, 1)设置 jsonObject = JsonConverter.ParseJson(jsonText)我 = 3ws.Cells(2, 1) = "颜色"ws.Cells(2, 2) = "十六进制代码"对于 jsonObject("0") 中的每个项目ws.Cells(i, 1) = item("颜色")ws.Cells(i, 2) = item("value")我 = 我 + 1下一个结束子
应如何更改此 VBA 代码,以便将上述 JSON 示例像表格一样放置在工作表上?
看看下面的例子.将
工作表 #2 上有展平的样本输出:
顺便说一句,类似的方法适用于其他答案.
I got some JSON parsing working. I use VBA to parse a JSON code from my webserver, write that to cell A1 at my Excel Worksheet. But I don't get this to convert into the other cells.
Here is my JSON sample:
{
"@type":["IN.areaList.1","OII.list.1"],
"@self":"/bereiche",
"list":[
{"@type":["IN.bereich.1"],
"@self":"/1.1.Bereich.2.7",
"scha":false,
"trlState":"",
"oiischa":false,
"readyTo1":false,
"readyTo2":false,
"numberOfBypassedDevices":0,
"test":"",
"TestActive":false,
"chModeActive":false,
"incs":[]}
]
}
This is my Sub, it is working for another sample:
Sub JsonToExcelExample()
Dim jsonText As String
Dim jsonObject As Object
Dim item As Object
Dim i As Long
Dim ws As Worksheet
Set ws = Worksheets("Remote")
jsonText = ws.Cells(1, 1)
Set jsonObject = JsonConverter.ParseJson(jsonText)
i = 3
ws.Cells(2, 1) = "Color"
ws.Cells(2, 2) = "Hex Code"
For Each item In jsonObject("0")
ws.Cells(i, 1) = item("color")
ws.Cells(i, 2) = item("value")
i = i + 1
Next
End Sub
How this VBA code should be changed so that the above JSON sample to be placed on the worksheet like a table?
Take a look at the below example. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
' Retrieve question #50068973 HTML content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://stackoverflow.com/questions/50068973", False
.send
sJSONString = .responseText
End With
' Extract JSON sample from the question
sJSONString = "{" & Split(sJSONString, "<code>{", 2)(1)
sJSONString = Split(sJSONString, "</code>", 2)(0)
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
End
End If
' Convert raw JSON to array and output to worksheet #1
JSON.ToArray vJSON, aData, aHeader
With Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
' Flatten JSON
JSON.Flatten vJSON, vResult
' Convert flattened JSON to array and output to worksheet #2
JSON.ToArray vResult, aData, aHeader
With Sheets(2)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "@"
.Value = aCells
End With
End With
End Sub
The output on the worksheet #1 for the raw sample you provided is as follows:
And there is the flattened sample output on the worksheet #2:
BTW, the similar approach applied in other answers.
这篇关于JSON VBA 解析到 Excel的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!