主题：[原创]测试报告源码

以下内容为程序代码:

1 Private Sub test2()
2 Dim cn As New ADODB.Connection
3 Dim rs As New ADODB.Recordset
4 Dim sql As String
5 Dim index As Integer
6 Dim stklabels(1 To 27) As String
7 Dim initialassets(1 To 27) As Double
8
9 cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\Trade\Report\Report.mdb"
10
11 sql = "select * from 初始权益"
12 rs.Open sql, cn, 3, 1
13
14 'index = rs.RecordCount
15
16 For i = 1 To rs.RecordCount
17 stklabels(i) = rs(0)
18 initialassets(i) = rs(1)
19 rs.MoveNext
20 Next
21
22 rs.Close
23
24 汇总净利润 = 0
25 汇总最大回撤 = 0
26 汇总收益风险比 = 0
27
28 For i = 1 To 2
29 初始权益 = 5000000
30 最大权益 = 0
31 回撤 = 0
32 最大回撤 = 0
33 Cells(1 + i, 1) = stklabels(i)
34 sql = "select min(日期) from 当前权益 where 品种='" + stklabels(i) + "' and 日期＞=cdate('2010-04-16')"
35 rs.Open sql, cn, 3, 1
36 Cells(1 + i, 2) = rs(0)
37 Cells(1 + i, 2).NumberFormatLocal = "yyyy/m/d"
38 rs.Close
39
40 sql = "select max(日期) from 当前权益 where 品种='" + stklabels(i) + "' and 日期＞=cdate('2010-04-16')"
41 rs.Open sql, cn, 3, 1
42 Cells(1 + i, 3) = rs(0)
43 Cells(1 + i, 3).NumberFormatLocal = "yyyy/m/d"
44 rs.Close
45
46 sql = "select 当前权益 from 当前权益 where 品种='" + stklabels(i) + "' and 日期＞=cdate('2010-04-16') order by 日期"
47 rs.Open sql, cn, 3, 1
48
49 Do While Not rs.EOF
50 当前权益 = rs(0)
51 If 当前权益 ＞ 最大权益 Then
52 最大权益 = 当前权益
53 Else
54 回撤 = 最大权益 - 当前权益
55 If 回撤 ＞ 最大回撤 Then
56 最大回撤 = 回撤
57 End If
58 End If
59
60 rs.MoveNext
61 Loop
62 净利润 = 当前权益 - 初始权益
63 收益风险比 = 净利润 / 最大回撤
64 Cells(1 + i, 4) = 净利润
65 Cells(1 + i, 5) = 最大回撤
66 Cells(1 + i, 6) = 收益风险比
67 rs.Close
68 Next
69
70 汇总初始权益 = 5000000 * 2
71 汇总最大权益 = 0
72 汇总回撤 = 0
73 汇总最大回撤 = 0
74
75 sql = "select sum(当前权益),日期 from 当前权益 group by 日期 having 日期＞=cdate('2010-04-16') order by 日期"
76 rs.Open sql, cn, 3, 1
77 Do While Not rs.EOF
78 汇总当前权益 = rs(0)
79 If 汇总当前权益 ＞ 汇总最大权益 Then
80 汇总最大权益 = 汇总当前权益
81 Else
82 汇总回撤 = 汇总最大权益 - 汇总当前权益
83 If 汇总回撤 ＞ 汇总最大回撤 Then
84 汇总最大回撤 = 汇总回撤
85 End If
86 End If
87
88 If 汇总最大回撤 ＞= 4000000 Then
89 MsgBox rs(1)
90 End If
91 rs.MoveNext
92 Loop
93
94 汇总净利润 = 汇总当前权益 - 汇总初始权益
95 汇总收益风险比 = 汇总净利润 / 汇总最大回撤
96 Cells(12, 4) = 汇总净利润
97 Cells(12, 5) = 汇总最大回撤
98 Cells(12, 6) = 汇总收益风险比
99 rs.Close
100 End Sub
101
102 Private Sub test()
103 Cells(3, 3) = "cccccc"
104 Dim cn As New ADODB.Connection
105 Dim rs As New ADODB.Recordset
106 Dim sql As String
107 Dim index As Integer
108 Dim stklabels(1 To 27) As String
109 Dim initialassets(1 To 27) As Double
110
111 cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\Trade\Report\Report.mdb"
112
113 sql = "select * from 初始权益"
114 rs.Open sql, cn, 3, 1
115
116 'index = rs.RecordCount
117
118 For i = 1 To rs.RecordCount
119 stklabels(i) = rs(0)
120 initialassets(i) = rs(1)
121 rs.MoveNext
122 Next
123
124 rs.Close
125
126 Cells(3, 3) = "bbbbb"
127
128 For i = 1 To 10
129 Cells(1 + i, 1) = stklabels(i)
130 sql = "select min(日期) from 当前权益 where 品种='" + stklabels(i) + "'"
131 rs.Open sql, cn, 3, 1
132 Cells(1 + i, 2) = rs(0)
133 rs.Close
134
135 sql = "select max(日期) from 当前权益 where 品种='" + stklabels(i) + "'"
136 rs.Open sql, cn, 3, 1
137 Cells(1 + i, 3) = rs(0)
138 rs.Close
139 Next
140 End Sub
141 Private Sub 提取数据_Click()
142 Application.ScreenUpdating = False
143
144 Dim cn As New ADODB.Connection
145 Dim rs As New ADODB.Recordset
146 Dim sql As String
147
148 cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\Trade\Report\Report.mdb"
149
150
151 sql = "select * from 设置"
152 rs.Open sql, cn, 3, 1
153
154 测试品种 = rs(0)
155 测试周期 = rs(1)
156 测试时间 = rs(2)
157 初始资金 = rs(3)
158 保证金率 = rs(4)
159 佣金滑点 = rs(5)
160
161 rs.Close
162
163
164 sql = "select 权益 from 权益 where 日期=(select max(日期) from 权益)"
165 rs.Open sql, cn, 3, 1
166
167 期末权益 = rs(0)
168 盈利金额 = 期末权益 - 初始资金
169 收益率 = 盈利金额 / 初始资金
170
171 rs.Close
172
173
174 sql = "select 平仓盈亏 from 权益"
175 rs.Open sql, cn, 3, 1
176
177 连赢 = 0
178 连亏 = 0
179 最大连赢 = 0
180 最大连亏 = 0
181
182 Do While Not rs.EOF
183 平仓盈亏 = rs(0)
184
185 If 平仓盈亏 ＞ 0 Then
186 连赢 = 连赢 + 1
187 连亏 = 0
188
189 If 连赢 ＞ 最大连赢 Then
190 最大连赢 = 连赢
191 End If
192 End If
193
194 If 平仓盈亏 = 0 Then
195 连赢 = 0
196 连亏 = 0
197 End If
198
199 If 平仓盈亏 ＜ 0 Then
200 连亏 = 连亏 + 1
201 连赢 = 0
202
203 If 连亏 ＞ 最大连亏 Then
204 最大连亏 = 连亏
205 End If
206 End If
207
208 rs.MoveNext
209 Loop
210
211 rs.Close
212
213
214 sql = "select 权益 from 权益"
215 rs.Open sql, cn, 3, 1
216
217 最大回撤 = 0
218 回撤率 = 0
219 最大权益 = 0
220
221 Do While Not rs.EOF
222 权益 = rs(0)
223
224 If 权益 ＞ 最大权益 Then
225 最大权益 = 权益
226 End If
227
228 回撤 = 权益 - 最大权益
229
230 If 回撤 ＜ 最大回撤 Then
231 最大回撤 = 回撤
232 End If
233
234 rs.MoveNext
235 Loop
236
237 rs.Close
238
239
240 sql = "select count(1) from (select distinct 开仓日期 from 交易明细)"
241 rs.Open sql, cn, 3, 1
242
243 交易天数 = rs(0)
244
245 rs.Close
246
247
248 sql = "select count(1) from 权益 where 平仓盈亏＞0"
249 rs.Open sql, cn, 3, 1
250
251 盈利天数 = rs(0)
252
253 rs.Close
254
255
256 sql = "select count(1) from 权益 where 平仓盈亏＜0"
257 rs.Open sql, cn, 3, 1
258
259 亏损天数 = rs(0)
260
261 rs.Close
262
263
264 sql = "select avg(平仓盈亏) from 权益"
265 rs.Open sql, cn, 3, 1
266
267 日均盈利 = rs(0)
268
269 rs.Close
270
271
272 sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏＞0"
273 rs.Open sql, cn, 3, 1
274
275 平均盈利 = rs(0)
276
277 rs.Close
278
279
280 sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏＜0"
281 rs.Open sql, cn, 3, 1
282
283 平均亏损 = rs(0)
284
285 rs.Close
286
287
288 sql = "select count(1) from 权益"
289 rs.Open sql, cn, 3, 1
290
291 观测天数 = rs(0)
292
293 rs.Close
294
295
296 sql = "select sum(平仓盈亏) from 交易明细"
297 rs.Open sql, cn, 3, 1
298
299 毛利润 = rs(0)
300
301 rs.Close
302
303
304 sql = "select sum(总手续费) from 交易明细"
305 rs.Open sql, cn, 3, 1
306
307 手续费 = rs(0)
308
309 rs.Close
310
311
312 成功率 = 盈利天数 / 交易天数
313 回撤率 = 最大回撤 / 最大权益
314 回报率 = 平均盈利 / -平均亏损
315 空仓天数 = 观测天数 - 交易天数
316 出击率 = 交易天数 / 观测天数
317 净利润 = 毛利润 - 手续费
318
319 If 毛利润 ＞ 0 Then
320 佣金率 = 手续费 / 毛利润
321 Else
322 佣金率 = 0
323 End If
324
325
326 Cells(3, 2) = 测试品种
327 Cells(3, 4) = 测试周期
328 Cells(3, 6) = 测试时间
329 Cells(3, 8) = 初始资金
330 Cells(3, 10) = 保证金率
331 Cells(3, 12) = 佣金滑点
332
333 Cells(6, 2) = 初始资金
334 Cells(7, 2) = 期末权益
335 Cells(8, 2) = 盈利金额
336 Cells(9, 2) = 收益率
337
338 Cells(6, 4) = 最大连赢
339 Cells(7, 4) = 最大连亏
340 Cells(8, 4) = 最大回撤
341 Cells(9, 4) = 回撤率
342
343
344 Cells(6, 6) = 交易天数
345 Cells(7, 6) = 盈利天数
346 Cells(8, 6) = 亏损天数
347 Cells(9, 6) = 成功率
348
349 Cells(6, 8) = 日均盈利
350 Cells(7, 8) = 平均盈利
351 Cells(8, 8) = 平均亏损
352 Cells(9, 8) = 回报率
353
354 Cells(6, 10) = 观测天数
355 Cells(7, 10) = 交易天数
356 Cells(8, 10) = 空仓天数
357 Cells(9, 10) = 出击率
358
359 Cells(6, 12) = 毛利润
360 Cells(7, 12) = 净利润
361 Cells(8, 12) = 手续费
362 Cells(9, 12) = 佣金率
363
364
365 sql = "select 日期,累计盈亏 from 权益"
366 rs.Open sql, cn, 3, 1
367
368 Range("y1").CopyFromRecordset rs
369
370 rs.Close
371
372 Range("y:y").NumberFormatLocal = "yyyy/m/d"
373 Range("z:z").NumberFormatLocal = "￥ #,##0"
374
375
376 Set r = Range("a12:l12")
377
378 Dim cht As ChartObject
379 Set cht = ChartObjects.Add(r.Left, r.Top, r.Width, 200)
380 cht.Chart.ChartType = xlArea
381 cht.Chart.ChartStyle = 5
382 cht.Chart.HasLegend = False
383 cht.Chart.SetSourceData Source:=Range("$Y:$Y,$Z:$Z")
384
385
386 sql = "select * from 交易明细 order by 开仓日期 desc"
387 rs.Open sql, cn, 3, 1
388
389 h = 30
390 For i = 1 To rs.RecordCount
391 Cells(h, 1) = i
392 Cells(h, 2) = rs(0)
393 Cells(h, 3) = rs(1)
394 Cells(h, 4) = rs(2)
395 Cells(h, 5) = rs(3)
396 Cells(h, 6) = rs(4)
397 Cells(h, 7) = rs(5)
398 Cells(h, 8) = rs(6)
399 Cells(h, 9) = rs(7)
400 Cells(h, 10) = rs(8)
401 Cells(h, 11) = rs(9)
402 Cells(h, 12) = rs(10)
403
404 Cells(h, 2).NumberFormatLocal = "yyyy/m/d"
405 Cells(h, 4).NumberFormatLocal = "h:mm"
406 Cells(h, 5).NumberFormatLocal = "￥ #,##0"
407 Cells(h, 7).NumberFormatLocal = "h:mm"
408 Cells(h, 8).NumberFormatLocal = "￥ #,##0"
409 Cells(h, 11).NumberFormatLocal = "￥ #,##0"
410 Cells(h, 12).NumberFormatLocal = "￥ #,##0"
411
412 r = "a" & h & ":" & "l" & h
413 Range(r).Font.Bold = True
414 Range(r).HorizontalAlignment = xlCenter
415 Range(r).Borders.LineStyle = xlContinuous
416 rs.MoveNext
417 h = h + 1
418 Next
419
420 rs.Close
421
422
423 cn.Close
424
425
426 Set rs = Nothing
427 Set cn = Nothing
428
429 Application.ScreenUpdating = True
430
431 End Sub
432
433 Private Sub 复制数据_Click()
434 ActiveSheet.Copy after:=Sheets(Sheets.Count)
435 Dim s As Shape
436 For Each s In ActiveSheet.Shapes
437 If s.Type = 8 Or s.Type = 12 Then
438 s.Delete
439 End If
440 Next
441 End Sub
442
443 Private Sub 清除数据_Click()
444 Cells(3, 2).ClearContents
445 Cells(3, 4).ClearContents
446 Cells(3, 6).ClearContents
447 Cells(3, 8).ClearContents
448 Cells(3, 10).ClearContents
449 Cells(3, 12).ClearContents
450
451 Cells(6, 2).ClearContents
452 Cells(7, 2).ClearContents
453 Cells(8, 2).ClearContents
454 Cells(9, 2).ClearContents
455
456 Cells(6, 4).ClearContents
457 Cells(7, 4).ClearContents
458 Cells(8, 4).ClearContents
459 Cells(9, 4).ClearContents
460
461
462 Cells(6, 6).ClearContents
463 Cells(7, 6).ClearContents
464 Cells(8, 6).ClearContents
465 Cells(9, 6).ClearContents
466
467 Cells(6, 8).ClearContents
468 Cells(7, 8).ClearContents
469 Cells(8, 8).ClearContents
470 Cells(9, 8).ClearContents
471
472 Cells(6, 10).ClearContents
473 Cells(7, 10).ClearContents
474 Cells(8, 10).ClearContents
475 Cells(9, 10).ClearContents
476
477 Cells(6, 12).ClearContents
478 Cells(7, 12).ClearContents
479 Cells(8, 12).ClearContents
480 Cells(9, 12).ClearContents
481
482 Range("a30:l9999").Clear
483
484 On Error Resume Next
485
486 ChartObjects(1).Delete
487
488 Range("y:z").Clear
489 End Sub
490