通过简单的VBA编写，我们可以让EXCEL变成股票查看软件，可以查看股票涨跌情况。如果录入了自己的持股信息，还可以查看自己的收益情况。也许有人会说有股票软件为什么还要用EXCEL来查看，这我就不解释了。

以下是EXCEL查看的界面，点“刷新”按钮可以实时刷新股票信息， 红框中的数据是VBA代码会更新的。点“刷新启停”按钮，可以让EXCEL自动刷新信息(5秒刷新一次)，再点一次停止自动刷新。

主界面

下面我们简单说下操作的步骤及代码。

1. 新建一个EXCEL文件，另存成“Excel启用宏的工作簿(*.slsm)

2. 打开菜单"开发工具"，点工具栏"插入"，选择铵钮进行，宏名输入宏名输入“refresh"， 按钮名称改为“刷新”。

3. 点上图中的"新建"打开VBA的编辑界面，在右边的代码窗口清空代码，输入文末的代码，保存后关闭VBA代码窗口。

由于代码有400多行，为避免影响阅读，放在了最后。

代码的原理是会针对EXCEL中的市场代码和股票代码，去特定的网址查询股票信息，解析后在页面显示。

4. 参照"刷新"按钮的创建方法，创建“刷新启停”按钮并指定宏名为startRefresh。

5. 参照主界面图输入基本信息，股票的代码根据自己的要求来填写。注意数据的开始位置必须和主界面图一致，否则就要自己调整了代码了。

通过以上步骤，属于你自己的EXCEL股票查看软件就创建完成了，点刷新就可以看到自己录入的股票的行情了。

需要原始EXCEL文档的，可以在留言区留下您的邮箱地址，我会在看到后邮件发送给你们。

代码：

Public startFlag As Boolean

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub refresh()

info ("刷新中...")

Application.ScreenUpdating = False '关闭屏幕刷新

displayMarket (6)

display (11)

Application.ScreenUpdating = True '打开屏幕刷新

info ("完成！")

End Sub

Sub refreshDetail()

If isExcelTradeOpen() Then

Exit Sub

End If

info ("刷新中...")

Application.ScreenUpdating = False '关闭屏幕刷新

'显示第1个股票

displayDetailInfo "C"

'显示第2个转债

displayDetailInfo "I"

'显示转债的股票

displayDetailInfo "O"

Application.ScreenUpdating = True '打开屏幕刷新

info ("完成！")

End Sub

Sub display(row As Integer)

'Dim row As Integer

'数据开始行

'row = 11

Do While True

Set cellName = Cells(row, "C")

If cellName = "" Then Exit Do

displayRow row

row = row + 1

Loop

End Sub

Sub displayMarket(row As Integer)

Do While True

Set cellName = Cells(row, "C")

If cellName = "" Then Exit Do

displayMarketRow row

row = row + 1

Loop

End Sub

Sub startRefresh()

If IsEmpty(startFlag) Then startFlag = False

Set cellAutoRefresh = Cells(4, "E")

startFlag = Not startFlag

If startFlag Then

cellAutoRefresh.Value = "自动刷新中..."

refreshTimerAction

Else

cellAutoRefresh.Value = "停止！"

End If

End Sub

Sub refreshTimerAction()

'Cells(8, "C").value = Cells(8, "C").value + 1

refresh

Dim newTime

'每5秒执行一次

newTime = Now + TimeValue("00:00:05")

If startFlag Then

Application.OnTime newTime, "refreshTimerAction"

End If

End Sub

Sub displayMarketRow(row As Integer)

Set cellCode = Cells(row, "D")

Dim stockCode As String

stockCode = cellCode.Value

displayInfo getSinaMarketCode(stockCode), row, False

End Sub

Sub displayRow(row As Integer)

Set cellCode = Cells(row, "D")

Dim stockCode As String

stockCode = cellCode.Value

displayInfo getSinaStockCode(stockCode), row, False

End Sub

Function getStockInfo(stockCode As String)

Dim url As String

'url = "http://hq.sinajs.cn/list=sh110032"

url = "http://hq.sinajs.cn/list="

url = url + stockCode

Dim responseText As String

responseText = getResponseText(url)

Dim array1, infoStr, infos

array1 = Split(responseText, """")

If UBound(array1) > 1 Then

infoStr = array1(1)

infos = Split(infoStr, ",")

End If

getStockInfo = infos

End Function

Function getSinaStockCode(stockCode As String)

Dim sinaStockCodeType As String

If (isMatch(stockCode, "6") Or isMatch(stockCode, "1A") Or isMatch(stockCode, "11")) Then

sinaStockCodeType = "sh"

ElseIf (isMatch(stockCode, "0") Or isMatch(stockCode, "300") Or isMatch(stockCode, "12")) Then

sinaStockCodeType = "sz"

End If

getSinaStockCode = sinaStockCodeType + stockCode

End Function

Function getSinaMarketCode(stockCode As String)

Dim sinaStockCodeType As String

'sh000001 000001

'sz399001 399001

'sz399006 399006

If (isMatch(stockCode, "000001")) Then

sinaStockCodeType = "sh"

ElseIf (isMatch(stockCode, "399001") Or isMatch(stockCode, "399006")) Then

sinaStockCodeType = "sz"

End If

getSinaMarketCode = sinaStockCodeType + stockCode

End Function

Function isMatch(stockCode As String, stockCodePrefix As String)

Dim match As Boolean

match = InStr(1, stockCode, stockCodePrefix) = 1

isMatch = match

End Function

Sub displayInfo(stockCode As String, row As Integer, detail As Boolean)

Dim infos

infos = getStockInfo(stockCode)

If UBound(infos) < 31 Then Exit Sub

'If Cells(6, "C") = infos(31) Then

' info ("无需刷新.")

' Exit Sub

'End If

columnIndex = 5 'E

'当前价 涨跌 涨跌幅

Set cellPrice = Cells(row, columnIndex)

columnIndex = columnIndex + 3

' 昨收

Set cellLastPrice = Cells(row, columnIndex)

columnIndex = columnIndex + 1

' 今开

Set cellOpen = Cells(row, columnIndex)

columnIndex = columnIndex + 1

'今低

Set cellLow = Cells(row, columnIndex)

columnIndex = columnIndex + 1

'今高

Set cellHigh = Cells(row, columnIndex)

columnIndex = columnIndex + 1

'var hq_str_sh601006="大秦铁路, 27.55, 27.25, 26.91, 27.55, 26.20, 26.91, 26.92,

'22114263, 589824680, 4695, 26.91, 57590, 26.90, 14700, 26.89, 14300,

' 26.88, 15100, 26.87, 3100, 26.92, 8900, 26.93, 14230, 26.94, 25150, 26.95, 15220, 26.96, 2008-01-11, 15:05:32";

'这个字符串由许多数据拼接在一起，不同含义的数据用逗号隔开了，按照程序员的思路，顺序号从0开始。

'0：”大秦铁路”，股票名字；

'Cells(4, "C") = infos(0)

'1：”27.55″，今日开盘价；

cellOpen.Value = infos(1)

'2：”27.25″，昨日收盘价；

cellLastPrice.Value = infos(2)

'3：”26.91″，当前价格；

cellPrice.Value = infos(3)

'4：”27.55″，今日最高价；

cellHigh.Value = infos(4)

'5：”26.20″，今日最低价；

cellLow.Value = infos(5)

'6：”26.91″，竞买价，即“买一”报价；

'7：”26.92″，竞卖价，即“卖一”报价；

'8：”22114263″，成交的股票数，由于股票交易以一百股为基本单位，所以在使用时，通常把该值除以一百；

'9：”589824680″，成交金额，单位为“元”，为了一目了然，通常以“万元”为成交金额的单位，所以通常把该值除以一万；

If (detail) Then

Dim buyPrice(1 To 5), buyQuantity(1 To 5), sellPrice(1 To 5), sellQuantity(1 To 5)

priceColumn = "Q"

quantityColumn = "R"

For i = 1 To 5

Set buyPrice(i) = Cells(9 + i, priceColumn)

Set buyQuantity(i) = Cells(9 + i, quantityColumn)

Set sellPrice(i) = Cells(10 - i, priceColumn)

Set sellQuantity(i) = Cells(10 - i, quantityColumn)

Next

'10：”4695″，“买一”申请4695股，即47手；

buyQuantity(1).Value = infos(10)

'11：”26.91″，“买一”报价；

buyPrice(1).Value = infos(11)

'12：”57590″，“买二”

buyQuantity(2).Value = infos(12)

'13：”26.90″，“买二”

buyPrice(2).Value = infos(13)

'14：”14700″，“买三”

buyQuantity(3).Value = infos(14)

'15：”26.89″，“买三”

buyPrice(3).Value = infos(15)

'16：”14300″，“买四”

buyQuantity(4).Value = infos(16)

'17：”26.88″，“买四”

buyPrice(4).Value = infos(17)

'18：”15100″，“买五”

buyQuantity(5).Value = infos(18)

'19：”26.87″，“买五”

buyPrice(5).Value = infos(19)

'20：”3100″，“卖一”申报3100股，即31手；

sellQuantity(1).Value = infos(20)

'21：”26.92″，“卖一”报价

sellPrice(1).Value = infos(21)

'(22, 23), (24, 25), (26,27), (28, 29)分别为“卖二”至“卖四的情况”

sellQuantity(2).Value = infos(22)

sellPrice(2).Value = infos(23)

sellQuantity(3).Value = infos(24)

sellPrice(3).Value = infos(25)

sellQuantity(4).Value = infos(26)

sellPrice(4).Value = infos(27)

sellQuantity(5).Value = infos(28)

sellPrice(5).Value = infos(29)

End If

'30：”2008-01-11″，日期；

'Cells(5, "C") = infos(30)

'31：”15:05:32″，时间；

'Cells(6, "C") = infos(31)

End Sub

Sub displayDetailInfo(stockCodeColumnName As String)

stockCodeColumn = Asc(stockCodeColumnName) - Asc("A") + 1

cellCode = Cells(3, stockCodeColumn)

Dim stockCode As String

stockCode = cellCode

Dim infos

infos = getStockInfo(stockCode)

If UBound(infos) < 31 Then Exit Sub

'If Cells(6, "C") = infos(31) Then

' info ("无需刷新.")

' Exit Sub

'End If

Set cellLastPrice = Cells(5, stockCodeColumn)

Set cellPrice = Cells(6, stockCodeColumn)

'今低

Set cellLow = Cells(6, stockCodeColumn + 2)

'今高

Set cellHigh = Cells(6, stockCodeColumn + 3)

'2：”27.25″，昨日收盘价；

cellLastPrice.Value = infos(2)

'3：”26.91″，当前价格；

cellPrice.Value = infos(3)

'4：”27.55″，今日最高价；

cellHigh.Value = infos(4)

'5：”26.20″，今日最低价；

cellLow.Value = infos(5)

Dim buyPrice(1 To 5), buyQuantity(1 To 5), sellPrice(1 To 5), sellQuantity(1 To 5)

priceColumn = stockCodeColumn

quantityColumn = stockCodeColumn + 1

sell1Row = 15

For i = 1 To 5

Set buyPrice(i) = Cells(sell1Row + i, priceColumn)

Set buyQuantity(i) = Cells(sell1Row + i, quantityColumn)

Set sellPrice(i) = Cells(sell1Row + 1 - i, priceColumn)

Set sellQuantity(i) = Cells(sell1Row + 1 - i, quantityColumn)

Next

'10：”4695″，“买一”申请4695股，即47手；

buyQuantity(1).Value = infos(10)

'11：”26.91″，“买一”报价；

buyPrice(1).Value = infos(11)

'12：”57590″，“买二”

buyQuantity(2).Value = infos(12)

'13：”26.90″，“买二”

buyPrice(2).Value = infos(13)

'14：”14700″，“买三”

buyQuantity(3).Value = infos(14)

'15：”26.89″，“买三”

buyPrice(3).Value = infos(15)

'16：”14300″，“买四”

buyQuantity(4).Value = infos(16)

'17：”26.88″，“买四”

buyPrice(4).Value = infos(17)

'18：”15100″，“买五”

buyQuantity(5).Value = infos(18)

'19：”26.87″，“买五”

buyPrice(5).Value = infos(19)

'20：”3100″，“卖一”申报3100股，即31手；

sellQuantity(1).Value = infos(20)

'21：”26.92″，“卖一”报价

sellPrice(1).Value = infos(21)

'(22, 23), (24, 25), (26,27), (28, 29)分别为“卖二”至“卖四的情况”

sellQuantity(2).Value = infos(22)

sellPrice(2).Value = infos(23)

sellQuantity(3).Value = infos(24)

sellPrice(3).Value = infos(25)

sellQuantity(4).Value = infos(26)

sellPrice(4).Value = infos(27)

sellQuantity(5).Value = infos(28)

sellPrice(5).Value = infos(29)

'30：”2008-01-11″，日期；

'Cells(5, "C") = infos(30)

'31：”15:05:32″，时间；

'Cells(6, "C") = infos(31)

End Sub

'取得网页内容

Function getResponseText(url As String)

Dim http

Dim responseText As String

Set http = CreateObject("Microsoft.XMLHTTP")

http.Open "POST", url, False

http.send ""

If http.Status = 200 Then

responseText = http.responseText

End If

Set http = Nothing

getResponseText = responseText

End Function

Sub info(message As String)

Set cellInfo = Cells(2, "G")

cellInfo.Value = message

End Sub