用Excel实时看股票数据--vba（无需安装任何软件）

环境：Win7+Excel2016（测试win10、wps也适用）

采用的是腾讯提供的股票接口，例如：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菜单->视图->宏->查看宏（VB宏），弹出宏对话框：

 

点击执行（或运行），就能看到数据被填充了：

（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