如何用VBA解析网抓到的JSON数据，并把数据显示在表格之中。

星梦月缘 · 发表于 2024-1-24 09:11

老师好，最近遇到一个网抓的问题，有一个网址的API接口是：api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=2024-01-24，数据结构是标准的json格式数据，现在需要处理Data中的数据，提取关键有效信息，提取之后到表格之后的样式如下：
图片所示.png

所需要的文件均已附件上传，希望哪位老师有空了帮忙处理下，非常感谢。

zpy2 · 发表于 2024-1-24 14:49

参与一下

//select * from Sheet1;
xli_add_php~～

$c=file_get_contents('https://api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=2024-01-24');
//file_put_contents('2.txt',$c);
//$c=file_get_contents('2.txt');
$json=json_decode($c,true);
$data=$json["result"]["data"];
function colchoose($v){
$flds=explode("\t","preDrawIssue preDrawTime preDrawCode");
foreach($flds as $fld){

$arr[$fld]=$v[$fld];
}
return $arr;
};
$result=array_map("colchoose",$data);
//print_r($json["result"]["data"]);
$result2=array_map(function ($v){
$v['preDrawCode']=str_replace(',','</td><td>',$v['preDrawCode']);
return $v;
},$result);
//print_r($result2);

\multiquery\g_ImportPhp('budget/arrayToTable');

arrayToTable($result2);

～;

tspliu · 发表于 2024-1-24 17:21

论坛里有很多处理json的贴子

星梦月缘 · 发表于 2024-1-24 22:44

tspliu 发表于 2024-1-24 17:21
论坛里有很多处理json的贴子

谢谢老师，根据老师的提示模仿着写出来了，谢谢。

星梦月缘 · 发表于 2024-1-25 22:31

给大家分享下我最后研究摸索出的代码有不合适的地方还请多多指教。

Sub cjsj() '采集部分数据
Application.ScreenUpdating = False
' 程序开始
On Error Resume Next
' Dim xmlhttp As Object
Dim baseUrl As String
Dim lotCode As String
Dim dateStr As String
Dim i, re, j, lastRow As Long
Dim arr
With Sheet2
n = n + 1
' 获取A列最后一个非空单元格的行号
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
' 计算A列中最大的数字
j = Application.WorksheetFunction.Max(.Range("A1:A" & lastRow)) - 1
End With
'lotCode = "10036"
dateStr = Format(Date, "yyyy-mm-dd") ' 当天日期
Set xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
'url = "https://api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=2024-01-24"
url = "https://api.api68.com/CQShiCai/getBaseCQShiCaiList.do?lotCode=10036&date=" & dateStr
With xmlhttp
.Open "Get", url, False
.send
' 获取返回数据
If .Status = 200 Then
m = .responseText
Else
Exit Sub
End If
End With
Set oDm = CreateObject("htmlfile")
Set oW = oDm.parentWindow
oW.execScript ("var query1 = " & m)
l = oW.Eval("M=query1[""result""][""data""].length") - 1
ReDim arr(1 To l + 1, 1 To 8)
For i = 0 To j
Dim drawData As Object
Set drawData = oW.Eval("M=query1[""result""][""data""][" & i & "]")
arr(i + 1, 1) = drawData.preDrawIssue
arr(i + 1, 2) = drawData.preDrawTime
arr(i + 1, 3) = drawData.preDrawCode
arr(i + 1, 4) = Split(arr(i + 1, 3), ",")(0)
arr(i + 1, 5) = Split(arr(i + 1, 3), ",")(1)
arr(i + 1, 6) = Split(arr(i + 1, 3), ",")(2)
arr(i + 1, 7) = Split(arr(i + 1, 3), ",")(3)
arr(i + 1, 8) = Split(arr(i + 1, 3), ",")(4)
Next
' 将数组中的数据写入表格
With Sheet1
re = .Range("a" & Rows.Count).End(xlUp).Row
If re > 3 Then
.Range("a3:H" & re).ClearContents
End If
.Range("A3").Resize(j + 1, 8).Value = arr
End With
Set oDom = Nothing
Set oW = Nothing
Application.ScreenUpdating = True
Sheets("实时数据").[C1] = n
End Sub

复制代码

pc_12 · 发表于 2024-1-26 20:27

工作簿1.rar (23.92 KB, 下载次数: 8)

perfect131 · 发表于 2024-1-27 14:23

星梦月缘发表于 2024-1-25 22:31
给大家分享下我最后研究摸索出的代码有不合适的地方还请多多指教。

不错，但是最好不要用eval 一没效率，二有bug, 三 Eval会报错(必须小写eval)

https://club.excelhome.net/thread-1572099-1-1.html

最好用 callbyname item的值，又快又稳（注意的是 key 是否存在的问题）

如果想写升序有偿找我

		自动登录	找回密码
密码			免费注册

[求助] 如何用VBA解析网抓到的JSON数据，并把数据显示在表格之中。

评分

评分

评分