请高人帮忙修改一下脚本

莫悠悠

[tr][/tr]
[tr][/tr]

Sub test0()     Dim url As String     Dim xmlhttp As Object     Dim json As Object     Dim arr(1 To 5000, 1 To 17)     Dim item, data     Dim i As Integer     Set xmlhttp = CreateObject("msxml2.xmlhttp")     With xmlhttp         .Open "GET", "http://push2.eastmoney.com/api/qt/clist/get?pn=1&pz=5000&po=1&np=1&ut=b2884a393a59ad64002292a3e90d46a5&fltt=2&invt=2&fid0=f4001&fid=f62&fs=m:0+t:6+f:!2,m:0+t:13+f:!2,m:0+t:80+f:!2,m:1+t:2+f:!2,m:1+t:23+f:!2,m:0+t:7+f:!2,m:1+t:3+f:!2&stat=1&fields=f12,f14,f2,f3,f62,f184,f66,f69,f72,f75,f78,f81,f84,f87,f204,f205,f124&rt=53517172&cb=jQuery183048059196149701094_1605515076827&_=1605515170671", False         .send         With CreateObject("msscriptcontrol.scriptcontrol")             .Language = "jscript"             .addcode "var data=" & xmlhttp.responsetext             Set json = .codeobject.data         End With         For Each item In json.data.diff             i = i + 1             With item                 arr(i, 1) = .f12                 arr(i, 2) = .f124                 arr(i, 3) = .f14                 arr(i, 4) = .f184                 arr(i, 5) = .f2                 arr(i, 6) = .f204                 arr(i, 7) = .f205                 arr(i, 8) = .f3                 arr(i, 9) = .f62                 arr(i, 10) = .f66                 arr(i, 11) = .f69                 arr(i, 12) = .f72                 arr(i, 13) = .f75                 arr(i, 14) = .f78                 arr(i, 15) = .f81                 arr(i, 16) = .f84                 arr(i, 17) = .f87             End With         Next item     End With     [a2].Resize(5000, 17) = arr End Sub 按瓢画葫芦改了下脚本，运行出错提示：“缺少对象”，请高人帮忙改改这个脚本 脚本出自：http://club.excelhome.net/forum. ... ;page=3#pid10528433

onlycxb

就抛出一段代码，怎么改

莫悠悠

onlycxb 发表于 2020-11-18 20:51
就抛出一段代码，怎么改

请见附件，谢谢

莫悠悠

onlycxb 发表于 2020-11-18 20:51
就抛出一段代码，怎么改

请问脚本没法修改吗？

onlycxb

莫悠悠 发表于 2020-11-30 16:36
请问脚本没法修改吗？

1. Sub test0()
   
2.     Dim url As String
   
3.     Dim xmlhttp As Object
   
4.     Dim json As Object
   
5.     Dim arr(1 To 5000, 1 To 17)
   
6.     Dim item, data
   
7.     Dim i As Integer
   
8.     Set xmlhttp = CreateObject("msxml2.xmlhttp")
   
9.     With xmlhttp
   
10.         .Open "GET", "http://push2.eastmoney.com/api/qt/clist/get?pn=1&pz=5000&po=1&np=1&ut=b2884a393a59ad64002292a3e90d46a5&fltt=2&invt=2&fid0=f4001&fid=f62&fs=m:0+t:6+f:!2,m:0+t:13+f:!2,m:0+t:80+f:!2,m:1+t:2+f:!2,m:1+t:23+f:!2,m:0+t:7+f:!2,m:1+t:3+f:!2&stat=1&fields=f12,f14,f2,f3,f62,f184,f66,f69,f72,f75,f78,f81,f84,f87,f204,f205,f124&rt=53517172&cb=&_=1605515170671", False
    
11.         .send
    
12.         With CreateObject("msscriptcontrol.scriptcontrol")
    
13.             .Language = "jscript"
    
14.             .addcode "var data=" & xmlhttp.responsetext
    
15.             Set json = .codeobject.data
    
16.         End With
    
17.         For Each item In json.data.diff
    
18.             i = i + 1
    
19.             With item
    
20.                 arr(i, 1) = "'" & .f12
    
21.                 arr(i, 2) = .f124
    
22.                 arr(i, 3) = .f14
    
23.                 arr(i, 4) = .f184
    
24.                 arr(i, 5) = .f2
    
25.                 arr(i, 6) = .f204
    
26.                 arr(i, 7) = .f205
    
27.                 arr(i, 8) = .f3
    
28.                 arr(i, 9) = .f62
    
29.                 arr(i, 10) = .f66
    
30.                 arr(i, 11) = .f69
    
31.                 arr(i, 12) = .f72
    
32.                 arr(i, 13) = .f75
    
33.                 arr(i, 14) = .f78
    
34.                 arr(i, 15) = .f81
    
35.                 arr(i, 16) = .f84
    
36.                 arr(i, 17) = .f87
    
37.             End With
    
38.         Next item
    
39.     End With
    
40.     [a2].Resize(5000, 17) = arr
    
41. End Sub
    

复制代码

莫悠悠

onlycxb 发表于 2020-11-30 18:03

谢谢老师出手相助

莫悠悠

onlycxb 发表于 2020-11-30 18:03

请教这个网址数据怎样提取？
http://dcfm.eastmoney.com/em_mut ... &js=%7Bpages%3A(tp)%2Cdata%3A(x)%7D&token=70f12f2f4f091e459a279469fe49eca5&filter=(HolderNumChangeRate%3D)(RangeChangeRate%3D)