主题：为期货连续合约生成除权复权数据的程序

以下内容为程序代码:

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