求助抓取新浪行情

YZC51

修改一位老师的代码，名字不记得啦！请见谅！
因网址上不去，未经调试，请您自己测试！

1. Sub yzc51()
   
2.     Set objXML = New XMLHTTP30
   
3.     Application.ScreenUpdating = False
   
4.     Cells.ClearContents
   
5.     URL = "http://money.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?num=2000&sort=symbol&asc=1&node=sz_a&page=1"
   
6.     For l = 1 To 2
   
7.    
   
8.         If l = 2 Then URL = "http://money.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?num=2000&sort=symbol&asc=1&node=sh_a&page=1"
   
9. 
   
10.         With objXML
    
11.             .Open "GET", URL, False
    
12.             .send
    
13.             txtCon = .responseText
    
14.         End With
    
15.    
    
16.         txtCon1 = Replace(txtCon, """", "")
    
17.         txtCon1 = Replace(txtCon1, "}]", "")
    
18.         arr = Split(txtCon1, "},{")
    
19.         For j = 0 To UBound(arr)
    
20.             Cells(jj + j + 2, 1) = j + 1 + jj
    
21.             arr1 = Split(arr(j), ",")
    
22.             For i = 1 To 19
    
23.                 Cells(jj + j + 2, i + 1) = Mid(arr1(i), InStr(1, arr1(i), ":") + 1)
    
24.             Next i
    
25.         Next j
    
26.         jj = j
    
27.     Next l
    
28.    
    
29.       [a1:t1] = Split("序号 代码 名称 最新价 涨跌额 涨跌幅 买入 卖出 昨收 今开 最高 最低 成交量/手 成交额/万 更新时间 市盈率 市净率 总市值 流通市值 换手率")
    
30.    
    
31.     Application.ScreenUpdating = True
    
32.     Set objXML = Nothing
    
33. End Sub
    

复制代码

五指山888

YZC51 发表于 2016-9-19 08:51
修改一位老师的代码，名字不记得啦！请见谅！
因网址上不去，未经调试，请您自己测试！

好的，谢谢，我看看，我觉得老师的抓取方法比其他方法快很多；第二句卡住，提示：用户定义类型未定义

YZC51

在第2句前插入下面语句试下!
    Dim objXML As XMLHTTP30

liu-aguang

五指山888 发表于 2016-9-18 20:55
谢谢liu-aguang老师，能用，就是打开80页太慢，如果用yzc51老师的方法可能很快，可惜他写的代码在2003版 ...

这下就快了：
Sub 股票1()
    Set oHttp = CreateObject("winHttp.winHttpRequest.5.1")
        oHttp.Open "GET", "http://vip.stock.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?page=1&num=1087&sort=symbol&asc=1&node=hs_a&symbol=&_s_r_a=init", False
        oHttp.send
        stext = oHttp.responseText
    Set regx = CreateObject("vbscript.regexp")
    regx.Pattern = "symbol:""([^""]*)[^:]+:[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:""([^""]*)[^:]+:(\d*)[^:]+:(\d*)"
    regx.Global = True
    Set mh = regx.Execute(stext)
    ReDim arr(mh.Count - 1, 12)
    For i = 0 To mh.Count - 1
        For j = 0 To 12
            arr(i, j) = mh(i).submatches(j)
        Next
    Next
    Range("a2").Resize(mh.Count, 13) = arr
End Sub

YZC51

五指山888 发表于 2016-9-19 10:31
好的，谢谢，我看看，我觉得老师的抓取方法比其他方法快很多；第二句卡住，提示：用户定义类型未定义

不可,不可!都是跟论坛上的老师们学的!
在liu-aguang 那学的很多知识!

五指山888

YZC51 发表于 2016-9-19 11:23
在第2句前插入下面语句试下!
    Dim objXML As XMLHTTP30

插入新语句没用，还是原来提示。是的，各位老师的方法各有千秋，都有借鉴作用，无私帮助值得赞扬，借此谢谢各位老师。我的意思是网抓有很多方法，不同网页适合的方法不同，可能方法不同，带来的效果不一样。
用了这一句Set HttpReq = CreateObject("MSXML2.XMLHTTP.3.0")作为第二句，第11句卡住，

YZC51

从昨天我按装东方财富客户端后,新浪网页的股票数据中心就进不去啦!今天卸载后,还是进不去!没办法!
请那位老师帮调试下!谢谢!

YZC51

五指山888 发表于 2016-9-19 12:46
插入新语句没用，还是原来提示。是的，各位老师的方法各有千秋，都有借鉴作用，无私帮助值得赞扬，借此谢 ...

请试下
2     Dim objXML As XMLHTTP30
3    Set objXML = New XMLHTTP30

五指山888

YZC51 发表于 2016-9-19 14:14
请试下
2     Dim objXML As XMLHTTP30
3    Set objXML = New XMLHTTP30

这个老师你前面已提示过，没用的另外我这边装了东方财富客户端几年，没和新浪网页有冲突，其他原因不知道了，实在没办法只能系统还原了

五指山888

YZC51 发表于 2016-9-19 14:07
从昨天我按装东方财富客户端后,新浪网页的股票数据中心就进不去啦!今天卸载后,还是进不去!没办法!
请那位 ...

我这边东方客户端已经装了好几年，和新浪没冲突，其他原因不知道了