環境：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
 

Private Sub Workbook_Open()
 Call Sheet1.GetData
End Sub

點選執行，就能看到資料被填充了：

（5）點選選項，可以設定快捷命令，例如Ctrl+R。

（6）Excel儲存為可以執行巨集的檔案，如stock.xlsm