抓取东方财富网上的个股资金流数据PQ可以轻松实现，VBA代码如何实现？

星梦月缘

需求描述：我想抓取东方财富网上的个股资金流的相关数据，我首先尝试了用PQ进行网抓，返回的数据清洗过之后，是标准的json格式的数据，直接很快就能解析出来，抓出来的效果如表格所示。

我有试着尝试 用VBA的方法进行抓取，能抓取到数据，但是JSON的格式数据解析一直有问题，一直解析不出来，试了两种方法，都没有成功  哪位老师给帮忙看下，谢谢。

看书上找了一个相似的代码，模仿着修改了下，但是一直没有成功，相关参考代码如下：  附件也已经上传

1. Sub WebCatchJSONData2()  '修改尝试
   
2.     Dim objXMLHTTP As Object
   
3.     Dim objDOM As Object
   
4.     Dim objWindow As Object
   
5.     Dim strURL As String
   
6.     Dim strText As String
   
7.     Dim intPageNum As Integer
   
8.     Dim i As Integer
   
9.     Dim j As Integer
   
10.     Dim lngRow As Long
    
11.     Dim intCol As Integer
    
12.     Dim avntTitle As Variant
    
13.     Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    
14.     Set objDOM = CreateObject("htmlfile")
    
15.     Set objWindow = objDOM.parentWindow
    
16.     Application.ScreenUpdating = False
    
17.     'strURL = "http://stockdata.stock.hexun.com/" _
    
18.         & "rzrq/data/Stock/DetailCollectDay.ashx"
    
19.     strURL = "https://push2.eastmoney.com/api/qt/clist/get?cb=jQuery112304205458899914081_1717003845816&fid=f62&po=1&pz=50&pn=3&np=1&fltt=2&invt=2&ut=b2884a393a59ad64002292a3e90d46a5&fs=m%3A0%2Bt%3A6%2Bf%3A!2%2Cm%3A0%2Bt%3A13%2Bf%3A!2%2Cm%3A0%2Bt%3A80%2Bf%3A!2%2Cm%3A1%2Bt%3A2%2Bf%3A!2%2Cm%3A1%2Bt%3A23%2Bf%3A!2%2Cm%3A0%2Bt%3A7%2Bf%3A!2%2Cm%3A1%2Bt%3A3%2Bf%3A!2&fields=f12%2Cf14%2Cf2%2Cf3%2Cf62%2Cf184%2Cf66%2Cf69%2Cf72%2Cf75%2Cf78%2Cf81%2Cf84%2Cf87%2Cf204%2Cf205%2Cf124%2Cf1%2Cf13"
    
20.         
    
21.     avntTitle = Array("f1", "f2", "f3", "f12", "f13", "f14", "f62", "f66", "f69", "f72", "f75", "f78", "f81", "f84", "f87", "f124", "f184", "f204", "f205", "f206")
    
22.     ActiveSheet.UsedRange.Offset(1).ClearContents
    
23.     lngRow = 1
    
24. '    Do While True
    
25. '        intPageNum = intPageNum + 1
    
26.         With objXMLHTTP
    
27.             .Open "GET", strURL, False
    
28.             .send
    
29.             strText = .responseText
    
30.         End With
    
31.         strText = Split(Split(strText, "]")(0), "[")(1)
    
32.         'If Len(strText) = 0 Then Exit Do
    
33.         strText = "<script>data=[" & strText & "]</script>"
    
34.         objDOM.Write strText
    
35.         For i = 0 To objWindow.eval("data.length") - 1
    
36.             lngRow = lngRow + 1
    
37.             intCol = 0
    
38.             For j = 0 To UBound(avntTitle)
    
39.                 intCol = intCol + 1
    
40.                 Cells(lngRow, intCol) = objWindow.eval("data[" & i & "]." & avntTitle(j))
    
41.             Next j
    
42.         Next i
    
43. '    Loop
    
44.     Application.ScreenUpdating = True
    
45.     Set objXMLHTTP = Nothing
    
46.     Set objDOM = Nothing
    
47.     Set objWindow = Nothing
    
48. End Sub

复制代码

满天星辰不及你

   只做了示范  获取方式都是一样的

满天星辰不及你

自行循环即可

wang-way

我已经用了很长一段时间了。用正则就可以提取出来

wang-way

满天星辰不及你 发表于 2024-5-30 14:04
只做了示范  获取方式都是一样的

感谢大佬提示  我去试试

星梦月缘

满天星辰不及你 发表于 2024-5-30 14:05
自行循环即可

老师 想问下 一般这种JSON格式的数据的话  是自行循环比较快，还是用其他老师写好的json的模块的内容直接调用解析比较快？谢谢

满天星辰不及你

星梦月缘 发表于 2024-5-31 11:38
老师 想问下 一般这种JSON格式的数据的话  是自行循环比较快，还是用其他老师写好的json的模块的内容直接 ...

循环1秒千万，不用考虑效率问题。 一般情况下慢是循环内部的其他代码

星梦月缘

满天星辰不及你 发表于 2024-5-31 13:31
循环1秒千万，不用考虑效率问题。 一般情况下慢是循环内部的其他代码

谢谢老师      我用json的解析 也模拟着做出来了。

星梦月缘

标记，谢谢各位老师的指点，我自己尝试摸索这 也弄出来一个   ，代码如下，仅供参考：

1. Sub ceshi()
   
2. Dim objXMLHTTP As Object
   
3.     Dim objDOM As Object
   
4.     Dim objWindow As Object
   
5.     Dim strURL As String
   
6.     Dim strText As String
   
7.     Dim intPageNum As Integer
   
8.     Dim i As Integer
   
9.     Dim j As Integer
   
10.     Dim lngRow As Long
    
11.     Dim intCol As Integer
    
12.     Dim avntTitle As Variant
    
13.     Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    
14.     Set objDOM = CreateObject("htmlfile")
    
15.     Set objWindow = objDOM.parentWindow
    
16.     Application.ScreenUpdating = False
    
17.    
    
18.     'strURL = "http://stockdata.stock.hexun.com/" _
    
19.         & "rzrq/data/Stock/DetailCollectDay.ashx"
    
20.     strURL = "https://push2.eastmoney.com/api/qt/clist/get?cb=jQuery112304205458899914081_1717003845816&fid=f62&po=1&pz=50&pn=" & intPageNum & "&np=1&fltt=2&invt=2&ut=b2884a393a59ad64002292a3e90d46a5&fs=m%3A0%2Bt%3A6%2Bf%3A!2%2Cm%3A0%2Bt%3A13%2Bf%3A!2%2Cm%3A0%2Bt%3A80%2Bf%3A!2%2Cm%3A1%2Bt%3A2%2Bf%3A!2%2Cm%3A1%2Bt%3A23%2Bf%3A!2%2Cm%3A0%2Bt%3A7%2Bf%3A!2%2Cm%3A1%2Bt%3A3%2Bf%3A!2&fields=f12%2Cf14%2Cf2%2Cf3%2Cf62%2Cf184%2Cf66%2Cf69%2Cf72%2Cf75%2Cf78%2Cf81%2Cf84%2Cf87%2Cf204%2Cf205%2Cf124%2Cf1%2Cf13"
    
21.         
    
22.     avntTitle = Array("f1", "f2", "f3", "f12", "f13", "f14", "f62", "f66", "f69", "f72", "f75", "f78", "f81", "f84", "f87", "f124", "f184", "f204", "f205", "f206")
    
23.    
    
24.    
    
25. '    Do While True
    
26. '        intPageNum = intPageNum + 1
    
27.         With objXMLHTTP
    
28.             .Open "GET", strURL, False
    
29.             .send
    
30.             strText = .responseText
    
31.         End With
    
32.         
    
33.         strText = Split(Split(strText, "]")(0), "[")(1)
    
34.         
    
35.           strText = "<script>data=[" & strText & "]</script>"
    
36.          
    
37.         'Range("a1") = strText
    
38.          objDOM.Write strText
    
39.          
    
40.         'Range("a2") = objWindow.eval("data[0].f14")
    
41.       
    
42.       
    
43.         For i = 0 To objWindow.eval("data.length") - 1
    
44.             lngRow = lngRow + 1
    
45.             intCol = 0
    
46.             For j = 0 To UBound(avntTitle)
    
47.                 intCol = intCol + 1
    
48.                 Cells(lngRow, intCol) = objWindow.eval("data[" & i & "]." & avntTitle(j))
    
49.             Next j
    
50.         Next i
    
51. '
    
52.   Application.ScreenUpdating = True
    
53.     Set objXMLHTTP = Nothing
    
54.     Set objDOM = Nothing
    
55.     Set objWindow = Nothing
    
56. 
    
57. End Sub

复制代码