|
- Option Explicit
- Sub demo()
- Application.ScreenUpdating = False
- Dim objXML, objJSON, objData, Ps%, P%, str$, Cell, nr, arr, Brr(1 To 10000, 1 To 11), k%, j%
- arr = Array("证券代码", "证券简称", "最新价", "涨跌幅", "成交量", "成交额", "振幅", "换手率", "委比", "量比", "市盈率")
- Set objXML = CreateObject("MSXML2.XMLHTTP")
- P = 1: Ps = 1
- Do While P <= Ps
- With objXML
- .Open "GET", "http://q.jrjimg.cn/?q=cn|s|sa&c=s,ta,tm,sl,cot,cat,ape&n=hqa&o=pl,d&p=" & P & "050", False
- .send
- str = .responsetext
- Ps = Val(Split(Split(str, "pages:")(1), ",page")(0))
- P = P + 1
- With CreateObject("msscriptcontrol.scriptcontrol")
- .Language = "JavaScript"
- .AddCode str
- Set objJSON = .CodeObject.hqa
- Set objData = CallByName(objJSON, "HqData", VbGet)
- For Each Cell In objData
- k = k + 1
- nr = Split(Cell, ",")
- Brr(k, 1) = nr(1): Brr(k, 2) = nr(2): Brr(k, 3) = nr(5)
- Brr(k, 4) = nr(9) & "%": Brr(k, 5) = nr(6): Brr(k, 6) = nr(7)
- Brr(k, 7) = nr(10) & "%": Brr(k, 8) = nr(13) & "%": Brr(k, 9) = nr(12) & "%"
- Brr(k, 10) = nr(11) & "%": Brr(k, 11) = nr(14)
- Next
- End With
- End With
- Loop
- With Sheet1
- .UsedRange.Clear
- .Columns("A").NumberFormatLocal = "@"
- .Range("a1").Resize(1, 11) = arr
- .Range("a2").Resize(k, 11) = Brr
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码 今天心情好,嘿嘿,所以,好心人来了 |
评分
-
查看全部评分
|