代码如下:
Sub 沪深A股() '东方财富网20201210
Application.ScreenUpdating = False
gs = 5000 '股票个数
qz1 = "http://70.push2.eastmoney.com/api/qt/clist/get?cb=jQuery1124024004342043745797_1607063800948&pn=1&pz="
qz2 = "&po=1&np=1&ut=bd1d9ddb04089700cf9c27f6f7426281&fltt=2&invt=2&fid=f3&fs=m:0+t:6,m:0+t:13,m:0+t:80,m:1+t:2,m:1+t:23&fields="
qz3 = "f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f14,f15,f16,f17,f18,f20" '只取有用数据
'qz3 ="f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f13,f14,f15,f16,f17,f18,f20,f21,f23,f24,f25,f22,f11,f62,f128,f136,f115,f152" '全部标题代码
'qz3 ="f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f14,f15,f16,f17,f18,f20" '筛选标题代码
qz4 = "&_=1607063800949"
url = qz1 & gs & qz2 & qz3 '& qz4
'url = "http://70.push2.eastmoney.com/api/qt/clist/get?cb=jQuery1124024004342043745797_1607063800948&pn=1&pz=20&po=1&np=1&ut=bd1d9ddb04089700cf9c27f6f7426281&fltt=2&invt=2&fid=f3&fs=m:0+t:6,m:0+t:13,m:0+t:80,m:1+t:2,m:1+t:23&fields=f1,f2,f3,f4,f5,f6,f7,f8,f9,f10,f12,f13,f14,f15,f16,f17,f18,f20,f21,f23,f24,f25,f22,f11,f62,f128,f136,f115,f152&_=1607063800949"
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", url, False
.send
v = .responseText
End With
Range("b2") = v
strText = Split(Split(v, "[{")(1), "}]")(0)
strText = Replace(strText, Chr(34), "") '去掉双引号
Range("b2") = strText
Set regEx = CreateObject("VBSCRIPT.REGEXP") 'RegEx为建立正则表达式
regEx.Global = True '设置全局可用
regEx.Pattern = "[a-z]\d+\:" '正则搜索样式
strText = regEx.Replace(strText, "") '替换为空
Range("b2") = strText
ar = Split(strText, "},{")
ReDim br(1 To UBound(ar) + 1, 1 To 17)
For i = 0 To UBound(ar)
s = Split(ar(i), ",")
br(i + 1, 1) = s(9) '股票代码
br(i + 1, 2) = s(10) '股票名称
br(i + 1, 4) = Val(s(1)) / 100 '涨跌幅
br(i + 1, 5) = Val(s(0)) '最新价
br(i + 1, 6) = Val(s(2)) '涨跌额
br(i + 1, 7) = Val(s(3)) / 10000 '成交量(手)
br(i + 1, 8) = Val(s(4)) / 100000000 '成交额(亿)
br(i + 1, 9) = Val(s(5)) '振幅
br(i + 1, 10) = Val(s(6)) '换手率
br(i + 1, 11) = Val(s(7)) '市盈率(动态)
br(i + 1, 12) = Val(s(8)) '量比
br(i + 1, 13) = Val(s(11)) '最高
br(i + 1, 14) = Val(s(12)) '最低
br(i + 1, 15) = Val(s(13)) '今开
br(i + 1, 16) = Val(s(14)) '昨收
br(i + 1, 17) = Val(s(15)) / 1000000000 '总市值(亿)
zxj = br(i + 1, 5)
zs = br(i + 1, 16)
If zxj = "-" Then
br(i + 1, 3) = "-"
Else
x = zxj - zs
If x > 0 Then '最新价和昨收的差
br(i + 1, 3) = "↑" '升
ElseIf x = 0 Then
br(i + 1, 3) = "-" '平
Else
br(i + 1, 3) = "↓" '降
End If
End If
Next
'bt = "f2最新价 f3涨跌幅 f4涨跌额 f5成交量(手) f6成交额(亿) f7振幅 f8换手率 f9市盈率(动态) f10量比 f12代码 f14名称 f15最高 f16最低 f17今开 f18昨收 f20总市值(亿)"
bt = "代码 名称 涨跌幅 最新价 涨跌额 成交量(手) 成交额(亿) 振幅 换手率 市盈率(动态) 量比 最高 最低 今开 昨收 总市值(亿)"
With Sheets("A股当天数据")
.Cells.ClearContents
.[a1:q1] = Split(bt)
.Range("a2").Resize(UBound(br), UBound(br, 2)) = br
n = .[a65536].End(3).Row
For i = 2 To n
If .Cells(i, 3) = "↑" Then
.Range(.Cells(i, 3), .Cells(i, 4)).Font.ColorIndex = 3 '升
ElseIf .Cells(i, 3) = "-" Then
.Range(.Cells(i, 3), .Cells(i, 4)).Font.ColorIndex = 1 '平
Else
.Range(.Cells(i, 3), .Cells(i, 4)).Font.ColorIndex = 4 '降
End If
Next
End With
Application.ScreenUpdating = True
End Sub
|