干货全拿走

干货全拿走"/>

干货全拿走

干货全拿走-用Excel制作小市值轮动价值投资选股器

一、 前言

二、 实现思路

三、 核心代码

四、 注意事项

一、前言

大数据时代，数据分析的价值愈发凸显，数据对于金融市场亦如是。现在越来越多的金融机构和个人借助专业的软件去做数据分析和获取数据，但是显然对于普通人来说，一是学习门槛高，二是年费高。普通人可能做股票，根本不会分析也不会有数据支撑，极少数的人有自己的策略和理论，大多数人都成了韭菜。普通人接触最多的数据分析处理的工具就是EXCEL，而用excel去支撑普通人一般对于股票数据分析的需求，就是我做这个系列的初衷，也是将我原来自己用的一些东西分享出来，发挥更大的价值吧。自己有一部分是用excel做的网抓，另外一部分是算法和模型，这次分享的就是算法和模型的部分了。

说到算法和模型，其实每个人可能都有自己的原则和策略，但是大家可能觉得只有用专业的软件才能实现。我不否认这些软件在数据分析方面的专业性，只是相对简单的算法的话，其实用什么语言写差别并不大。Excel本身的函数公式和VBA扩展其实可以支持搭建一些选股模型的。

小市值策略应该说是一个比较成熟的量化策略了，这个策略简单来说就是轮动选择流动市值相对较小，并且财务指标向好，估值较低的股票，然后主观上再结合一些题材，就锦上添花了。相关的数据正好之前我都做过对应的网抓程序，所以可以获取到，正好可以用到，就打算用VBA实现一下了。

二、实现思路

（1）验证策略有效性。小市值策略本身就为市面有效的策略，并且我还加了一些优化的地方，所以对这个策略还是有信心的。不过为了保险，还是在某平台上面跑了下回测，年收益率50+%，满意。其实单纯为了用这个策略的话，完全不用自己写代码，直接用平台就可以了。主要是因为这个策略虽然综合收益率不错，但是夏普比率不太好，进不去策略商城，没法上线卖，悲催。所以感觉自己写出来可以分享下赚些知乎收益也不错。

（2）找数据源。这个是最关键的一步，没有数据源一切都白扯。“巧妇难为无米之炊”。这里主要是用到了历史市盈率、历史量价数据、历史市值数据，以最新期的财报数据。相关数据都可以用之前的下载器下载到，方法类似，感兴趣的可以看我的这篇帖子：

用Excel实现自动获取期货、期权、股票行情及下载历史数据 - 知乎

（3）选股指标设计。网抓获取到了数据后，就是看如何去分析他们了。这里设计选股指标，我的选股策略及指标如下：

按照这个策略轮动选择，基本上目标股票符合以下几个特征：

一是小市值，这个代表资金介入后非常容易拉升。

二是低估值，这个代表上升空间大。

三是活跃度高但是稳健。这个代表交易热度大，可能会启动拉升盘，同时又可避免选到妖股接盘。

四是当前价格相对低。这个代表损失风险相对小。

（4）代码实现和界面设计。

界面主要是基于Excel设计的，用Excel就可以使用。基本上有网抓、选股和数据存储三个模块，数据存储的话，分为多个工作表，如下：

获取界面样本可以访问：

样本数据链接：

提取码：1234

三、核心代码

先看下最后完成的效果，我上传了视频，可以直接观看（视频简介中可以获取源程序）：

/

代码方面，选股的主程序如下（其中分别调用了多个选股指标判断的VBA工程）：

Sub CmdFilter()

On Error Resume Next

ReDim Preserve StockCodeArray(ThisWorkbook.Worksheets("数据看板").Range("A1048576").End(xlUp).Row - 6)

ReDim Preserve StockNameArray(ThisWorkbook.Worksheets("数据看板").Range("B1048576").End(xlUp).Row - 6)

ReDim Preserve FilterCodeResultArray(0)

ReDim Preserve FilterNameResultArray(0)

ThisWorkbook.Worksheets("选股器").Range("A3:B" & (ThisWorkbook.Worksheets("选股器").Range("B1048576").End(xlUp).Row + 3)).ClearContents

For i = 0 To UBound(StockCodeArray)

StockCodeArray(i) = ThisWorkbook.Worksheets("数据看板").Range("A" & (i + 6)).Text

StockNameArray(i) = ThisWorkbook.Worksheets("数据看板").Range("B" & (i + 6)).Text

Next

ProcessWindow.Show vbModeless

For i = 0 To UBound(StockCodeArray)

'这一部分循环遍历，对逐个筛选条件进行计算看是否符合

FilterYes = True '初始设置为符合筛选条件

'这里需要注意，StockCodeArray的第一个股票代码实际是在每个工作表的第6行，所以后面筛选判定中都是行号加6考虑。

If ThisWorkbook.Worksheets("选股器").Range("F3").Value = "是" Then Call MarketValueFilter '近Y日平均流通市值≤X亿

If ThisWorkbook.Worksheets("选股器").Range("F4").Value = "是" Then Call PeFilter '近Y日平均市盈率低于全历史分位点X%

If ThisWorkbook.Worksheets("选股器").Range("F5").Value = "是" Then Call TurnOverRangeUpFilter '近Y日平均换手率≥X%

If ThisWorkbook.Worksheets("选股器").Range("F6").Value = "是" Then Call TurnOverRangeDownFilter '近Y日平均换手率≤X%

If ThisWorkbook.Worksheets("选股器").Range("F7").Value = "是" Then Call ChangeRangeFilter '近Y日平均振幅≥X%

If ThisWorkbook.Worksheets("选股器").Range("F8").Value = "是" Then Call BottomClosePriceRateFilter '近Y日内收盘价均值为所选数据周期内后X%

If ThisWorkbook.Worksheets("选股器").Range("F9").Value = "是" Then Call ContinueUpDaysFilter '近Y日收盘价涨幅≥0的天数≥X

If ThisWorkbook.Worksheets("选股器").Range("F10").Value = "是" Then Call ChangeRateFilter '近Y日收盘价平均涨幅≥X%（支持负数）

If FilterYes = True Then

ReDim Preserve FilterCodeResultArray(UBound(FilterCodeResultArray) + 1)

ReDim Preserve FilterNameResultArray(UBound(FilterNameResultArray) + 1)

FilterCodeResultArray(UBound(FilterCodeResultArray)) = StockCodeArray(i)

FilterNameResultArray(UBound(FilterNameResultArray)) = StockNameArray(i)

Else

End If

Percent = 100 * Round(i / (UBound(StockCodeArray) + 1), 2)

With ProcessWindow

.FrmProgress.Caption = "选股已执行" & Percent & "%，请耐心等待，或使用Ctrl+Shift+Esc强制终止"

.LblProgress.Width = Percent * (.FrmProgress.Width - 10) / 100

.Repaint

End With

Next

'这里写入筛选后的结果

Dim FilterCodeResultArrayNew()

Dim FilterNameResultArrayNew()

ReDim Preserve FilterCodeResultArrayNew(UBound(FilterCodeResultArray) - 1)

ReDim Preserve FilterNameResultArrayNew(UBound(FilterNameResultArray) - 1)

For i = 1 To UBound(FilterCodeResultArray)

FilterCodeResultArrayNew(i - 1) = FilterCodeResultArray(i)

FilterNameResultArrayNew(i - 1) = FilterNameResultArray(i)

Next

ThisWorkbook.Worksheets("选股器").Range("A3:A" & (3 + UBound(FilterCodeResultArrayNew))).Value = Application.Transpose(FilterCodeResultArrayNew)

ThisWorkbook.Worksheets("选股器").Range("B3:B" & (3 + UBound(FilterNameResultArrayNew))).Value = Application.Transpose(FilterNameResultArrayNew)

ProcessWindow.Hide

'If ThisWorkbook.Worksheets("选股器").Range("A3").Value = "" Then MsgBox "无满足条件的结果"

End Sub

五、 注意事项

Excel作为一个办公软件，有它的方便性，但是也有局限。就是它的计算内核并不能与大数据分析或者数据库软件（可轻松处理大于1个GB的数据等）相比，处理海量数据的话真的会卡死。所以即便是开发选股器，如果要将全部股票，全部时间尺度的数据导入分析会非常困难，我也只是导入了所有股票近1-2个月的数据进行选股。不过这个取决于策略，如果你的选股策略只是用到近期数据的话，实际也没有太大影响，并且结合网抓可以进行轮动回测。比如我另外开发的一个基于短期情绪的选股模型，就是用的短期数据分析，用于选股或者打板，感兴趣的可以查看演示视频（视频简介中可以获取源程序：/

软件地址：.htm?ft=t&id=682837366515