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

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

用excel股票分析

主界面

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

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

用excel股票分析

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

用excel股票分析

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

用excel股票分析

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

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

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

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

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

需要原始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用excel股票分析:”大秦铁路”,股票名字用excel股票分析

'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