求助抓取新浪行情

YZC51

五指山888 发表于 2016-9-18 15:09
还是走不通，搞到现在不知问题在哪儿，第13行出错，不过先谢谢老师

我这能正常运行，可能是版本的问题！我这2007。
修改下，请测试！

YZC51

附件如下：
东方行情下载.rar (381.58 KB, 下载次数: 222)

2016-9-18 16:19 上传

点击文件名下载附件

五指山888

YZC51 发表于 2016-9-18 16:27
附件如下：

好的，谢谢

liu-aguang

五指山888 发表于 2016-9-18 11:01
行情中心_新浪财经_新浪网  http://vip.stock.finance.sina.com.cn/mkt/#hs_a，能打开的

1. Sub 股票()
   
2.     Set oDom = CreateObject("htmlfile")
   
3.     Set oWindow = oDom.parentWindow
   
4.     Set oHttp = CreateObject("winHttp.winHttpRequest.5.1")
   
5.     r = 1
   
6.         For y = 1 To 3 '设置读取页数
   
7.         oHttp.Open "GET", "http://vip.stock.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?page=" & y & "&num=40&sort=symbol&asc=1&node=hs_a&symbol=&_s_r_a=init", False
   
8.         oHttp.send
   
9.         stext = oHttp.responseText
   
10.         If stext = "null" Then Exit Sub
    
11.         oWindow.execScript "o=" & stext
    
12.         For i = 0 To oWindow.eval("o.length") - 1
    
13.             r = r + 1
    
14.             oWindow.execScript "oi=o[" & i & "];a=[];for(x in oi){a.push(oi[x])}"
    
15.             ar = Split(oWindow.a, ",")
    
16.             For j = 1 To 13
    
17.                 k = IIf(j = 1, 0, j)
    
18.                 Cells(r, j) = ar(k)
    
19.             Next j
    
20.         Next i
    
21.     Next y
    
22. End Sub
    

复制代码

五指山888

YZC51 发表于 2016-9-18 16:27
附件如下：

1  Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)还是运行到这句会停顿，
2.扩大抓取列的是哪一句，现在抓取的是27列，网页数据在33列以上，修改那一句可以扩展列。
3关掉这个工作簿，光标还是在打圈，是不是有循环没终止。
谢谢老师看看能否解决第三个问题估计是程序是2007的关系，第一个问题也是版本的问题

YZC51

五指山888 发表于 2016-9-18 16:59
1  Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)还是运行到这句会停顿，
2.扩大抓 ...

1. 注销此句试下 '    Dim arr() As String
2.  ' Call FenLie
    Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=1, Comma:=True, FieldInfo:=Array(Array(1, 9), Array(2, 1)), TrailingMinusNumbers:=True
3.不应该的,请其他老师帮测试下。

YZC51

将'    Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)
修改为    Range("b2").Resize(UBound(arr) + 1) = Application.Transpose(arr)

五指山888

YZC51 发表于 2016-9-18 17:41
将'    Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)
修改为    Range("b2").Resize( ...

还是一样

五指山888

liu-aguang 发表于 2016-9-18 16:59

谢谢liu-aguang老师，能用，就是打开80页太慢，如果用yzc51老师的方法可能很快，可惜他写的代码在2003版本不能用，前面写的下载st的非常快。

五指山888

YZC51 发表于 2016-9-18 17:10
1. 注销此句试下 '    Dim arr() As String
2.  ' Call FenLie
    Columns("B:B").TextToColumns Dest ...

第二个问题解决了