实际测试环境:Win7+Excel2016
采用的是腾讯提供的股票接口,例如:http://qt.gtimg.cn/q=sh600016,返回输入如下:
v_sh600016="1~民&……%生银行~600016~8.58~8.68~8.67~886218~499700~386518~8.58~772~8.57~6361~8.56~8593~8.55~12720~8.54~6803~8.59~4279~8.60~9390~8.61~2093~8.62~3318~8.63~3836~15:00:04/8.58/1/S/858/27675|15:00:01/8.58/817/B/701197/27670|14:59:58/8.58/306/B/262275/27663|14:59:55/8.58/261/B/223686/27659|14:59:52/8.57/37/S/31709/27655|14:59:49/8.58/134/B/114869/27649~20170803150552~-0.10~-1.15~8.74~8.56~8.58/885400/764678837~886218~76538~0.30~6.48~~8.74~8.56~2.07~2535.54~3130.45~0.90~9.55~7.81~0.84";
提取其中的名称(民…%银行),收盘价格,昨日价格,涨跌百分比即可。
(1)打开Excel2016,保证第一列输入股票代码(第一行除外),2、3、4、5列留着待用,其余列根据需求自行添加,如下图:
2)按ALT+F11,在Sheet1的VBA通用代码中加入如下代码:
Function FillOneRow(url As String, r As Integer) As Integer
With CreateObject("msxml2.xmlhttp")
.Open "GET", url, False
.send
sp = Split(.responsetext, "~")
If UBound(sp) > 3 Then
FillOneRow = 1
Cells(r, 2).Value = sp(1) '名称
Cells(r, 3).Value = sp(3) '当前价格
Cells(r, 4).Value = sp(4) '昨日收盘价
Dim zhangDie As Double
zhangDie = sp(32)
Cells(r, 5).Value = zhangDie
If zhangDie > 0 Then
'上涨使用红色
Cells(r, 5).Font.Color = vbRed
Cells(r, 3).Font.Color = vbRed
Else
'下跌使用绿色
Cells(r, 5).Font.Color = &H228B22
Cells(r, 3).Font.Color = &H228B22
End If
Else
FillOneRow = 0
End If
End With
End Function
Sub GetData()
Dim succeeded As Integer
Dim url As String
Dim row As Integer
Dim code As String
For row = 2 To Range("A1").CurrentRegion.Rows.Count '从第二行开始
code = Cells(row, 1).Value
If code <> "" Then
url = "http://qt.gtimg.cn/q=sh" & code '沪市
succeeded = FillOneRow(url, row)
If succeeded = 0 Then
url = "http://qt.gtimg.cn/q=sz" & code '深市
succeeded = FillOneRow(url, row)
End If
If succeeded = 0 Then
MsgBox ("获取失败")
End If
End If
Next
End Sub
(3)选择ThisWorkbook选项,添加Workbook的Open函数,这样在excel打开的时候就会自动执行GetData
Private Sub Workbook_Open()
Call Sheet1.GetData
End Sub
(4)关闭VBA,在Excel菜单->视图->宏->查看宏,弹出宏对话框:
点击执行,就能看到数据被填充了:
(5)点击选项,可以设置快捷命令,例如Ctrl+R。
(6)Excel保存为可以运行宏的文件,如stock.xlsm
(7)补充:网友回复无法区分sz和sh,这里把GetData函数修改了一下,让第一列可以输入纯数字或者带字母的输入,比如sz000001
Sub GetData()
Dim succeeded As Integer
Dim url As String
Dim row As Integer
Dim code As String
Dim dateStr As String
Dim cash As String
Dim current As String
Dim firstCode As String
Dim secondCode As String
current = Date
Dim currentRow As Integer
currentRow = 0
Dim zhangDie As Double
Dim isSet As Boolean
For row = 2 To Range("A1").CurrentRegion.Rows.Count
code = Cells(row, 1).Value
succeeded = 0
If code <> "" Then
firstCode = LCase(Mid(code, 1, 1))
secondCode = LCase(Mid(code, 2, 1))
If firstCode = "s" And secondCode = "h" Then
url = "http://qt.gtimg.cn/q=" & Cells(row, 1).Value
succeeded = FillOneRow(url, row)
ElseIf firstCode = "s" And secondCode = "z" Then
url = "http://qt.gtimg.cn/q=" & Cells(row, 1).Value
succeeded = FillOneRow(url, row)
Else
If firstCode <> "0" Then
url = "http://qt.gtimg.cn/q=sh" & Cells(row, 1).Value
succeeded = FillOneRow(url, row)
End If
If succeeded = 0 Then
url = "http://qt.gtimg.cn/q=sz" & Cells(row, 1).Value
succeeded = FillOneRow(url, row)
End If
End If
If succeeded = 0 Then
MsgBox ("获取失败")
End If
End If
Next
End Sub
————————————————