为期货连续合约生成除权复权数据的程序　[金字塔]

写了个计算连续合约除权复权数据的VBA程序，欢迎指正。

功能：在换月时，把连续合约换月造成的跳空缺口按换月后合约的实际跳空缺口进行复权，坛上有许多方法介绍，如为期货连续合约建立除权复权数据http://www.weistock.com/BBS/dispbbs.asp?boardid=2&id=7342&page=3&move=pre。

本程序的计算方法与股票分红除权类似：例如，IF00在2013年6月19日的主力合约为IF06，6月20日主力合约切换到IF07，主力合约切换时IF06、IF07 的前收盘价（即6月19日收盘价）分别为2395、2377.8，那么将生成一条除权日期为6月20日，每10股分红为10*(2395-2377.8)=172的除权数据。如果新主力合约前收盘大于旧主力合约前收盘，则该值为负数。金字塔允许分红数、送股数为负数，大多数国内股软是不允许的，赞一个。

用法：

（1）停止VBA运行，把后面的VBA程序复制到模块中并修改需要计算的品种；

（2）运行VBA，选择“工具”“扩展”“生成连续合约除权数据”，生成除权文件。

（3）在数据管理中引入除权数据。

问题：一定把相关合约的日数据补充齐全，否则计算结果肯定有误；似乎2010以前的除权算不出来，可能是连续合约的持仓与各月份合约不同，有待进一步检查。

以下内容为程序代码:

1 Sub Menu_Show()
2     call Menu.AddMenu(0, 0, "生成连续合约除权数据")
3 End Sub
4 Sub MENU_Command(Cmd)
5     select case cmd
6     case 0
7         GenSplit "ZJIF;SQRB","d:\split.txt" '这里根据您的需要修改，注意参数格式
8     end select
9 End Sub
10 Sub GenSplit(contract,cqfile)
11 '功能：生成连续合约除权数据文件
12 '参数contract为以半角分号分隔的交易所+合约品种代码，如"ZJIF;SQCU;DQY;"
13 ' 其中,市场代码：中金所是ZJ，上期所SQ,郑商所ZQ,大连所DQ；合约品种代码不包含月份；DQA、ZQWS、ZQSR等不加后面的X和Y。
14 '参数cqfile为除权文件名，如"d:\split.txt"
15 '注：本程序用持仓量找主力合约。如果用成交量，确保计算时处于非复权状态，或者取消对成交量复权。
16
17     if msgbox("请确保“" & contract &"”的连续合约、各月份合约的日线历史数据已保存在本地硬盘！"&vbcrlf&"确定继续？",vbOKCancel,"确定")=vbCancel then exit sub
18     msg=""
19     out="证券代码"& Chr(9) &"时间"& Chr(9) &"红股(10送)"& Chr(9) &"配股(10配)"& Chr(9) &"配股价"& Chr(9) &"红利(10送)" & vbcrlf '除权文件头，汉字以TAB字符分隔
20     mktsecs=Split(contract,";")
21     mkt=""
22     sec=""
23     Set c_date_oi = CreateObject("Scripting.Dictionary") '连续合约日期、持仓量
24     Set d = CreateObject("Scripting.Dictionary") '合约代码
25     '====遍历指定的品种====
26     for each mkt_sec in mktsecs
27         mkt=left(mkt_sec,2)
28         sec=mid(mkt_sec,3)
29         c_sym="" '保存连续合约代码
30         '===遍历指定市场下的所有合约，找出指定品种的连续合约和月份合约===
31         seccount = MarketData.GetReportCount(mkt)
32         for i=0 to seccount-1
33             Set rpt1 = MarketData.GetReportDataByIndex(mkt,i)
34             mm=Right(rpt1.Label, 2)
35             imm=CInt(mm)
36             if sec=left(rpt1.Label,len(sec)) and imm=0 then '连续合约
37                 c_sym=rpt1.Label
38                 set h=MarketData.GetHistoryData(c_sym,mkt,5)
39                 for j=0 to h.Count-1
40                     if not c_date_oi.Exists(h.Date(j)) then c_date_oi.Add h.Date(j), h.Openint(j)
41                 next
42             End if
43             If sec=left(rpt1.Label,len(sec)) and imm＞=1 and imm＜=12 then '月份合约
44                 if not d.Exists(rpt1.label) then d.Add rpt1.label,0
45             End If
46         Next
47         '===根据连续合约和月份合约日线数据，生成除权数据===
48         if c_sym＜＞"" and d.Count＞0 then
49             prevsym="" '保持前一个主力合约代码
50             prevclose = 0 '保持前一个主力合约的收盘价
51             for each c_date in c_date_oi.Keys '遍历连续合约的每个交易日
52                 for each sym in d.Keys '遍历每个合约，通过持仓量找出主力合约
53                     set h=MarketData.GetHistoryData(sym,mkt,5) '每次取历史数据，效率稍低
54                     curpos=h.GetPosFromDate(c_date)
55                     if h.Date(curpos)=c_date and h.Openint(curpos)=c_date_oi.item(c_date) then '判断与连续合约持仓相等的合约，即主力合约
56                         newprevclose=h.Close(curpos-1) '新主力合约的前一收盘价
57                         if prevsym＜＞sym and prevclose＞0 then '找到新主力合约
58                             msg=msg & mkt_sec& " " & c_sym &" " & c_date & " 前一主力合约 " & prevsym &" 前一交易日收盘价=" & prevclose & ",当前主力合约 " & sym & " 的前一交易日收盘价=" & newprevclose &" 当前收盘价=" & h.Close(curpos) & vbcrlf
59                             out=out & mkt & c_sym & Chr(9) & ( year(c_date)*10000+month(c_date)*100+day(c_date) ) & Chr(9) & "0.0" & Chr(9) & "0.0" & Chr(9) & "0.0" & Chr(9) & FormatNumber((prevclose-newprevclose)*10,2,-1,0,0) & vbcrlf
60                         end if
61                         prevsym=sym
62                         prevclose=h.Close(curpos)
63                         exit for
64                     end if
65                 next
66             next
67         End if
68         c_date_oi.RemoveAll
69         d.RemoveAll
70     next ' for each mkt_sec in mktsecs
71     'Application.MsgOut msg
72     '====保存除权数据====
73     Set fso = CreateObject("Scripting.FileSystemObject")
74     Set f = fso.OpenTextFile(cqfile, 2, True) 'ForWriting = 2, ForAppending = 8
75     f.Write(out)
76     f.Close
77     'Application.MsgOut out
78     msgbox "除权数据文件保存在"&cqfile &",请用JZT数据管理器导入！"
79 End sub

生成的IF00除权数据如下：

证券代码 时间 红股(10送) 配股(10配) 配股价 红利(10送)
ZJIF00 20100519 0.0 0.0 0.0 -314.00
ZJIF00 20100618 0.0 0.0 0.0 -184.00
ZJIF00 20100716 0.0 0.0 0.0 -68.00
ZJIF00 20100819 0.0 0.0 0.0 -164.00
ZJIF00 20100917 0.0 0.0 0.0 -102.00
ZJIF00 20101015 0.0 0.0 0.0 -192.00
ZJIF00 20101112 0.0 0.0 0.0 -714.00
ZJIF00 20101216 0.0 0.0 0.0 -302.00
ZJIF00 20110121 0.0 0.0 0.0 -118.00
ZJIF00 20110216 0.0 0.0 0.0 -260.00
ZJIF00 20110317 0.0 0.0 0.0 -158.00
ZJIF00 20110415 0.0 0.0 0.0 -168.00
ZJIF00 20110518 0.0 0.0 0.0 -128.00
ZJIF00 20110617 0.0 0.0 0.0 -70.00
ZJIF00 20110715 0.0 0.0 0.0 -114.00
ZJIF00 20110817 0.0 0.0 0.0 -48.00
ZJIF00 20110916 0.0 0.0 0.0 -50.00
ZJIF00 20111020 0.0 0.0 0.0 -16.00
ZJIF00 20111117 0.0 0.0 0.0 -58.00
ZJIF00 20111216 0.0 0.0 0.0 -88.00
ZJIF00 20120119 0.0 0.0 0.0 -140.00
ZJIF00 20120216 0.0 0.0 0.0 -120.00
ZJIF00 20120315 0.0 0.0 0.0 -82.00
ZJIF00 20120419 0.0 0.0 0.0 -146.00
ZJIF00 20120517 0.0 0.0 0.0 -58.00
ZJIF00 20120614 0.0 0.0 0.0 76.00
ZJIF00 20120719 0.0 0.0 0.0 -84.00
ZJIF00 20120816 0.0 0.0 0.0 -122.00
ZJIF00 20120920 0.0 0.0 0.0 -156.00
ZJIF00 20121019 0.0 0.0 0.0 -180.00
ZJIF00 20121116 0.0 0.0 0.0 -74.00
ZJIF00 20121219 0.0 0.0 0.0 -142.00
ZJIF00 20130117 0.0 0.0 0.0 -130.00
ZJIF00 20130208 0.0 0.0 0.0 -206.00
ZJIF00 20130315 0.0 0.0 0.0 -50.00
ZJIF00 20130419 0.0 0.0 0.0 36.00
ZJIF00 20130516 0.0 0.0 0.0 170.00
ZJIF00 20130620 0.0 0.0 0.0 172.00

抱歉。无法编辑了，请帮忙移动或删除。

感谢，补充数据后，能生成以前的除权数据。数据的准确性，与金字塔数据准确性有关。