寫了個計算連續合約除權復權數據的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

抱歉。無法編輯了，請幫忙移動或刪除。

感謝，補充數據后，能生成以前的除權數據。數據的準確性，與金字塔數據準確性有關。