|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
代码正在审核Sub getData()
Dim url$, XML, str$
url = "http://web.ifzq.gtimg.cn/appstock/app/HotStock/getHotRankIndex?_var=hotRank&" & Rnd()
Set XML = CreateObject("MSXML2.XMLHTTP")
Cells.Clear
With XML
.Open "GET", url, False
.send
str = StrConv(.responsebody, 64)
End With
Dim regx As Object, I%, j%, arr()
Set regx = CreateObject("vbscript.regexp")
regx.Pattern = "index"":""(.*?)"",""symbol"":""(.*?)"",""rankdelta"":""(.*?)"",""rank"":""(.*?)"",""level"":""(.*?)"",""name"":""(.*?)"",""zdf"":""(.*?)""}"
regx.MultiLine = True '多行
regx.Global = True
Set mh = regx.Execute(str)
op = Split(str, "rankTime"":""")(1)
ReDim Preserve arr(1 To mh.Count, 1 To 7)
For I = 0 To mh.Count - 1
m = m + 1
For j = 0 To mh(I).submatches.Count - 1
arr(m, j + 1) = StringConv(mh(I).submatches(j))
Next
Next '"rankTime":"12-15 14:45:01"}}}
[a1].Resize(1, 7) = Split("index 股票代码 rankdelta rank level 股票名称 涨幅")
[a2].Resize(m, 7) = arr
[h2] = "5分钟最热" & Split(Split(str, "rankTime"":""")(1), """}")(0): Range("H2:H11").Merge
[h12] = "1小时最热" & Split(Split(str, "rankTime"":""")(2), """}")(0): Range("H12:H21").Merge
[h22] = "今日最热" & Split(Split(str, "rankTime"":""")(3), """}")(0): Range("H22:H31").Merge
[h32] = "7日最热" & Split(Split(str, "rankTime"":""")(4), """}")(0): Range("H32:H41").Merge
End Sub
Function StringConv(ByVal Str1 As String) As String
Dim I As Long
Dim strArr() As String
Dim RegExp As Object
Dim Match As Object
On Error Resume Next
Set RegExp = CreateObject("VBScript.RegExp")
If RegExp Is Nothing Then Exit Function
With RegExp
.Pattern = "\\u[A-F\d]{2,4}(?=\b)"
.Global = True
.IgnoreCase = True
Set Match = .Execute(Str1)
For I = 0 To Match.Count - 1
Str1 = Replace(Str1, Match(I), ChrW(Replace(Match(I), "\u", "&H", 1, , vbTextCompare)))
Next I
End With
Set Match = Nothing
Set RegExp = Nothing
StringConv = Str1
End Function
|
|