求助抓取新浪行情

五指山888

求助大师，行情中心_新浪财经_新浪网  http://vip.stock.finance.sina.com.cn/mkt/#hsgs_shfxjs这个网址的数据抓取到excel里的代码如何写，谢谢

YZC51

用好啦，记得赏花啊！

1. Sub Main2()
   
2.     Dim strText As String
   
3. '   For i = 1 To 36
   
4.         strText = HtmlStr("http://vip.stock.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?page=1&num=80&sort=symbol&asc=1&node=shfxjs&symbol=&_s_r_a=setlen") & "},"
   
5. '    Next
   
6.     'strText = strConv1(strText)
   
7.     Set reg = CreateObject("vbscript.regexp") 'ÕýÔò:"
   
8.     reg.Global = True
   
9.     reg.Pattern = "[a-z"":]"
   
10.     strText = reg.Replace(strText, "")
    
11.    
    
12.     strText = Replace(strText, ",,", ",")
    
13.     strText = Replace(strText, ",1,", "")
    
14. 'Debug.Print strText
    
15.     Cells.ClearContents
    
16.     Dim arr() As String
    
17.     arr = Split(strText, "},")
    
18.     Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)
    
19.    
    
20.     Columns("B:B").TextToColumns Destination:=Range("B1"), Comma:=True, FieldInfo:=Array(Array(1, 1), Array(2, 9))
    
21. 
    
22.     [a2] = 1: [a3] = 2: [a2:a3].AutoFill Range("a2:a" & UBound(arr) + 1)
    
23. 
    
24. '    Rows(1).Insert
    
25. Range([a1], Cells(1, "t")) = Split("ÐòºÅ ´úÂë Ãû³Æ ×îÐÂ¼Û Õǵø¶î Õǵø·ù ÂòÈë Âô³ö ×òÊÕ ½ñ¿ª ×î¸ß ×îµÍ ³É½»Á¿/ÊÖ ³É½»¶î/Íò   Êо» ×ÜÊÐÖµ Á÷ͨÊÐÖµ »»ÊÖ")
    
26. End Sub
    
27. 
    
28. Function HtmlStr(url As String) As String
    
29.     Dim xmlHttp
    
30.     Set xmlHttp = CreateObject("Microsoft.XMLHTTP")
    
31.     xmlHttp.Open "GET", url, False
    
32.     xmlHttp.send
    
33.     If xmlHttp.ReadyState = 4 Then
    
34.         url = StrConv(xmlHttp.responseBody, vbUnicode)
    
35.     Else
    
36.         HtmlStr = ""
    
37.         Exit Function
    
38.     End If
    
39.     Set xmlHttp = Nothing
    
40.    
    
41.     Dim i1 As Long, i2 As Long
    
42.     i1 = InStr(1, url, "[")
    
43.     i2 = InStr(i1, url, "]")
    
44.     url = Mid(url, i1 + 1, i2 - i1 - 2)
    
45.     url = Replace(url, """:", ",")
    
46.     url = Replace(url, """", "")
    
47.     url = Replace(url, "{", "")
    
48.     HtmlStr = url
    
49. End Function
    

复制代码

五指山888

YZC51 发表于 2016-9-16 10:11
用好啦，记得赏花啊！

谢谢！基本是这样，我自己消化一下，有问题再请教，节日快乐！

YZC51

五指山888 发表于 2016-9-16 15:18
谢谢！基本是这样，我自己消化一下，有问题再请教，节日快乐！

节日快乐！！！

五指山888

YZC51 发表于 2016-9-16 15:28
节日快乐！！！

表头看不懂，我有两列猜不出是啥数据，其他几列都知道了，老师能看一下吗？

YZC51

将25行替换为下面的代码
Range([a1], Cells(1, "t")) = Split("序号 代码 名称 最新价 涨跌额 涨跌幅 买入 卖出 昨收 今开 最高 最低 成交量/手 成交额/万 更新时间 本益比 平均市净率 市值 流通市值 换手率")

五指山888

YZC51 发表于 2016-9-17 00:15
将25行替换为下面的代码
Range([a1], Cells(1, "t")) = Split("序号 代码 名称 最新价 涨跌额 涨跌幅 买入 ...

谢谢！这么晚了，还在工作，再次感谢老师的帮助！

YZC51

这样更准确些
[a1:t1] = Split("序号 代码 名称 最新价 涨跌额 涨跌幅 买入 卖出 昨收 今开 最高 最低 成交量/手 成交额/万 更新时间 市盈率 市净率 总市值 流通市值 换手率")

YZC51

在最后加一句
    [O:O].NumberFormatLocal = "00"":""00"":""00"

YZC51

最终代码

1. Sub 行情下载()
   
2.     Sheets("Sheet1").Select
   
3.     Cells.ClearContents
   
4.     strText = HtmlStr("http://vip.stock.finance.sina.com.cn/quotes_service/api/json_v2.php/Market_Center.getHQNodeData?page=1&num=80&sort=symbol&asc=1&node=shfxjs&symbol=&_s_r_a=setlen") & "},"
   
5.     Set reg = CreateObject("vbscript.regexp")
   
6.     reg.Global = True
   
7.     reg.Pattern = "[a-z"":]"
   
8.     strText = reg.Replace(strText, "")
   
9.     strText = Replace(strText, ",,", ",")
   
10.     strText = Replace(strText, ",1,", "")
    
11.     Cells.ClearContents
    
12.     Dim arr() As String
    
13.     arr = Split(strText, "},")
    
14.     Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)
    
15.     Columns("B:B").TextToColumns Destination:=Range("B1"), Comma:=True, FieldInfo:=Array(Array(1, 1), Array(2, 9))
    
16.     [a2] = 1: [a3] = 2: [a2:a3].AutoFill Range("a2:a" & UBound(arr) + 1)
    
17.     [a1:t1] = Split("序号 代码 名称 最新价 涨跌额 涨跌幅 买入 卖出 昨收 今开 最高 最低 成交量/手 成交额/万 更新时间 市盈率 市净率 总市值 流通市值 换手率")
    
18.     [O:O].NumberFormatLocal = "00"":""00"":""00"
    
19.     Range("W1").Select
    
20. End Sub
    

复制代码