[原創]和昨天相比今天增加或減少的合約 [金字塔]
- 咨詢內容：
期貨里有的時候突然有些合約就開始有成交量了, 而有的合約不知何時就沒有成交量了.
作為每日收盤后對當天行情的統計的一部分, 我們也許需要判斷:
(1) 哪些合約昨日沒有成交量而今日有非零的成交量;
(2) 那些合約昨日有非零的成交量而今日的成交量卻是零;
(3) 哪些主力合約今日沒有成交.這里主力的定義沿用金字塔的官方認定.
為實現以上目的, 金字塔vbs代碼如下, 以活躍論壇, 給各位看官以福利, 也感謝金字塔多年的使用.
也許您覺得這是雕蟲小技, 但是從每日成交合約的變化, 也許可以未雨綢繆.
ps:
主要是沒有用字典---虛擬機里字典會出錯, 而是用一些簡單的辦法繞過而自是寫個類似字典的東西;
再者用ini, 還有vbs的for循環里面不能用if...else if....等等, 無他.
以下內容為程序代碼:
1 sub myGetTickCmmdt()
2 Dim marketName, useFuture
3 Dim fso, outputf, d, d_num, dmain, dmain_num, prefixStockNameCur, suffixStockNameCur, lastPrefix, dirc
4 useFuture = 1
5
6 if useFuture = 1 then
7 marketName=Array("SQ","DQ","ZQ","ZJ")
8 end if
9 NameFolder = year(date)*10000 + month(date)*100 + day(date)
10 Set fso = CreateObject("scripting.filesystemobject")
11 Set d = CreateObject("Stock.ArrayString")
12 Set d_num = CreateObject("Stock.Array")
13 Set dmain = CreateObject("Stock.ArrayString")
14 Set dmain_num = CreateObject("Stock.Array")
15 dirc = "C:\Users\ui\Stock.ini"
16 lastPrefix = " "
17 msgbox "hi"
18
19 For j=0 To UBound(marketName)
20 n = marketData.GetReportCount(marketName(j))
21
22 outputf_0 = "C:\Users\ui\Downloads\jk\"&NameFolder&"\"&marketName(j)& "\"
23
24 For i=0 To n-1
25 Set reportData = marketdata.GetReportDataByIndex(marketName(j),i)
26 IF useFuture = 1 then
27 parseStockName reportData.label, prefixStockNameCur, suffixStockNameCur
28
29 IF suffixStockNameCur＞="00" and suffixStockNameCur＜="99" and reportData.Volume ＜= 0 THEN
30 aligning reportData.label, 0, d, d_num
31 IF suffixStockNameCur = "00" THEN
32 aligning reportData.label, 0, dmain, dmain_num
33 END IF
34 END IF
35 IF suffixStockNameCur＞="00" and suffixStockNameCur＜="99" and reportData.Volume ＞ 0 THEN
36 aligning reportData.label, reportData.Volume, d, d_num
37 IF suffixStockNameCur = "00" THEN
38 aligning reportData.label, reportData.Volume, dmain, dmain_num
39 END IF
40
41 IF lastPrefix ＜＞ prefixStockNameCur THEN
42 lastPrefix = prefixStockNameCur
43 END IF
44 End If
45 end if
46 Next
47 Next
48
49 IF 1 = useFuture Then
50 'checkPrefixSuffix d, d_num
51 checkLabel d, d_num, dmain, dmain_num, marketName, dirc
52 END IF
53 set fso = Nothing
54 set d = Nothing
55 set d_num = Nothing
56 set dmain = Nothing
57 set dmain_num = Nothing
58 end sub
59
60
61 Sub checkLabel(ByRef dq, ByRef dq_num, ByRef dm, ByRef dm_num, mktName, dirc)
62 Dim newContracts, justLosingContracts, newContracts_num, justLosingContracts_num
63 SET newContracts = CreateObject("Stock.ArrayString")
64 SET justLosingContracts = CreateObject("Stock.ArrayString")
65 SET newContracts_num = CreateObject("Stock.Array")
66 SET justLosingContracts_num = CreateObject("Stock.Array")
67
68 Set fs = CreateObject("Scripting.FileSystemObject")
69 Set f = fs.GetFile(dirc)
70 tmp_ = dirc&".0"
71 application.MsgOut tmp_
72 f.Copy tmp_
73 set f = Nothing
74 set fs = Nothing
75
76 For j = 0 To dq.count - 1
77 label = dq.Getat(j)
78 statPre = Document.GetPrivateProfileInt("MyCpp", label, -1, dirc)
79 IF statPre = -1 THEN
80 msgbox "failed to fetch_from_ini for " & label
81 application.MsgOut "failed to fetch_from_ini for " & label
82 EXIT SUB
83 END IF
84
85 statNow = dq_num.Getat(j)
86 IF statPre = 0 and statNow ＜＞ 0 THEN
87 newContracts.addBack(label)
88 newContracts_num.addBack(statNow)
89 tmp = Document.WritePrivateProfileInt("MyCpp", label, 1, dirc)
90 END IF
91 IF statPre ＜＞ 0 and statNow = 0 THEN
92 justLosingContracts.addBack(label)
93 justLosingContracts_num.addBack(statPre)
94 tmp = Document.WritePrivateProfileInt("MyCpp", label, 0, dirc)
95 END IF
96 NEXT
97
98 For i = 0 To dm.count - 1
99 if 0 = dm_num.getat(i) THEN
100 application.MsgOut "MISSING Main: " & dm.getat(i)
101 END IF
102 NEXT
103
104 printStockarraystring newContracts, newContracts_num, "newContracts"
105 printStockarraystring justLosingContracts, justLosingContracts_num, "justLosingContracts"
106 SET newContracts = Nothing
107 SET justLosingContracts = Nothing
108 SET newContracts_num = Nothing
109 SET justLosingContracts_num = Nothing
110 End Sub
111
112 Sub printStockarraystring(ByRef arraytoprint, ByRef array_num, names)
113 For i = 0 To arraytoprint.count - 1
114 application.MsgOut names & ":" & arraytoprint.GetAt(i) & "|" & array_num.GetAt(i)
115 NEXT
116 END Sub
117
118 sub aligning(label, int_num, ByRef d, ByRef d_num)
119 d.AddBack(label)
120 int_a = CLng(int_num)
121 d_num.addback(int_a)
122 end sub
123
124 sub parseStockName(label, ByRef prefixStockName, ByRef suffixStockName)
125 select case len(label)
126 case 4
127 prefixStockName=left(label,2)
128 case 3
129 prefixStockName=left(label,1)
130 case 5
131 prefixStockName=left(label,3)
132 case else
133 application.MsgOut "wrong future label " & label
134 msgbox "wrong future label " & label
135 end select
136 suffixStockName=right(label,2)
137 end sub
138
139 Sub checkPrefixSuffix(ByRef dq, ByRef dq_num)
140 Dim tmp_prefix_last, tmp_label, tmp_suffix_last, tmp_prefix, tmp_suffix
141 Dim tmp_array
142 tmp_prefix_last = " "
143 tmp_suffix_last = "00"
144 Set tmp_array = CreateObject("Stock.ArrayString")
145
146 For j = 0 To dq.count - 1
147 IF 0 ＜＞ dq_num.getat(j) THEN
148 tmp_array.addback dq.getat(j)
149 END IF
150 NEXT
151 tmp_array.Sort(0)
152
153 For i = 0 To tmp_array.count - 1
154 tmp_label = tmp_array.GetAt(i)
155 parseStockName tmp_label, tmp_prefix, tmp_suffix
156
157 If tmp_prefix_last ＜＞ tmp_prefix Then
158 IF "00" ＜＞ tmp_suffix_last THEN
159 application.MsgOut "ODD: prefix:" & tmp_prefix_last & " suffix:" & tmp_suffix_last
160 END IF
161 tmp_suffix_last = tmp_suffix
162 tmp_prefix_last = tmp_prefix
163 ELSE
164 IF tmp_suffix ＜ tmp_suffix_last THEN
165 tmp_suffix_last = tmp_suffix
166 END IF
167 End If
168 Next
169
170 IF "00" ＜＞ tmp_suffix_last THEN
171 application.MsgOut "ODD SUFFIX " & tmp_prefix_last & " " & tmp_suffix_last
172 END IF
173
174 set tmp_array = Nothing
175 End Sub
176
- 金字塔客服：
不錯，謝謝分享，稍后我們會將該主題轉移至策略發布區
有思路，想編寫各種指標公式，程序化交易模型，選股公式，預警公式的朋友
可聯系技術人員 QQ: 511411198 進行 有償 編寫！（不貴！點擊查看價格！）
相關文章
-
沒有相關內容
會員登錄/注冊