Excel使用VBA读取实时WebService股票数据

实际测试环境：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

————————————————