我在 VBA 中解析 JSON 数据时遇到一些问题。我已经尝试了网上的所有示例,但仍然无法解决问题。我设法做的是使用另一个从另一个网站提取数据的 VBA 代码将 JSON 数据以原始格式提取到 Excel 中。我粘贴了下面有效的代码。它不是很干净,而且有一些重复,因为我只是想看看是否可以提取数据。
我尝试使用 VBA 解析数据的所有尝试都失败了,并出现了各种错误,具体取决于我采取的方法。如果有人能给我一些关于解析我设法提取的数据的最简单方法的建议,我将非常感激。我所需要的只是列中的数据,然后我可以在工作簿的其他工作表中使用这些数据。我附上了我提取的数据的图片。我已成功解析来自另一个网页的 JSON 数据,并在代码中包含 JSON 数据的每个列标题。对于这个新网页,JSON 数据是嵌套的,并且有大量独特的行,因此我没有采用这种方法。非常感谢
[Sub JSONPull()
Dim WB As Workbook, ws As Worksheet, ws2 As Worksheet, qtb As QueryTable
Dim FC As String, sDate As String, eDate As String, Dockmasterurl As String, Performance As Worksheet
Set WB = Application.ThisWorkbook
Set ws = WB.Sheets("Control")
FC = ws.Range("B5")
sDate = ws.Range("B14")
eDate = ws.Range("B15")
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
Dockmasterurl = "https://fc-inbound-dock-execution-service-eu-eug1-dub.dub.proxy.amazon.com/appointment/bySearchParams?warehouseId=" & FC & "&clientId=dockmaster&localStartDate=" & sDate & "T00%3A00%3A00&localEndDate=" & eDate & "T08%3A00%3A00&isStartInRange=false&searchResultLevel=FULL"
Set ws2 = Sheets("JSON")
ws2.Cells.ClearContents
Set qtb = ws2.QueryTables.Add("URL;" & Dockmasterurl, ws2.Range("A1"))
With qtb
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ws2.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, textqualifier:=xlDoubleQuote, consecutivedelimiter:=False, comma:=True, trailingminusnumbers:=True
ws2.Range("A:S").EntireColumn.AutoFit
For Each qtb In ws2.QueryTables
qtb.Delete
Next
End Sub][1]
这是 VBA 示例,展示了如何链接中的 JSON 示例可以转换为二维数组并输出到工作表。Import JSON.bas将模块添加到 VBA 项目中以进行 JSON 处理。
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://pastebin.com/raw/hA2UEDXy", True
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then MsgBox "Invalid JSON": End
' Convert JSON to 2D Array
JSON.ToArray vJSON("AppointmentList"), aData, aHeader
' Output to worksheet #1
Output aHeader, aData, ThisWorkbook.Sheets(1)
MsgBox "Completed"
End Sub
Sub Output(aHeader, aData, oDestWorksheet As Worksheet)
With oDestWorksheet
.Activate
.Cells.Delete
With .Cells(1, 1)
.Resize(1, UBound(aHeader) - LBound(aHeader) + 1).Value = aHeader
.Offset(1, 0).Resize( _
UBound(aData, 1) - LBound(aData, 1) + 1, _
UBound(aData, 2) - LBound(aData, 2) + 1 _
).Value = aData
End With
.Columns.AutoFit
End With
End Sub
我的输出如下(点击放大):
顺便说一句,应用了类似的方法在其他答案中.
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)