- 金字塔客服中心 - 专业程序化交易软件提供商 (http://www.weistock.com/bbs/index.asp)
-- 高级功能研发区 (http://www.weistock.com/bbs/list.asp?boardid=5)
---- [原创]测试报告源码 (http://www.weistock.com/bbs/dispbbs.asp?boardid=5&id=9418)
-- 发布时间：2011/12/18 12:48:09
-- [原创]测试报告源码
以下内容为程序代码:
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
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
[此贴子已经被作者于2011-12-18 12:51:42编辑过]
-- 发布时间：2011/12/18 12:48:41
--
Private Sub test2()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim index As Integer
Dim stklabels(1 To 27) As String
Dim initialassets(1 To 27) As Double
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 初始权益"
rs.Open sql, cn, 3, 1
\'index = rs.RecordCount
For i = 1 To rs.RecordCount
stklabels(i) = rs(0)
initialassets(i) = rs(1)
rs.MoveNext
Next
rs.Close
汇总净利润 = 0
汇总最大回撤 = 0
汇总收益风险比 = 0
For i = 1 To 2
初始权益 = 5000000
最大权益 = 0
回撤 = 0
最大回撤 = 0
Cells(1 + i, 1) = stklabels(i)
sql = "select min(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\')"
rs.Open sql, cn, 3, 1
Cells(1 + i, 2) = rs(0)
Cells(1 + i, 2).NumberFormatLocal = "yyyy/m/d"
rs.Close
sql = "select max(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\')"
rs.Open sql, cn, 3, 1
Cells(1 + i, 3) = rs(0)
Cells(1 + i, 3).NumberFormatLocal = "yyyy/m/d"
rs.Close
sql = "select 当前权益 from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\') order by 日期"
rs.Open sql, cn, 3, 1
Do While Not rs.EOF
当前权益 = rs(0)
If 当前权益 > 最大权益 Then
最大权益 = 当前权益
Else
回撤 = 最大权益 - 当前权益
If 回撤 > 最大回撤 Then
最大回撤 = 回撤
End If
End If
rs.MoveNext
Loop
净利润 = 当前权益 - 初始权益
收益风险比 = 净利润 / 最大回撤
Cells(1 + i, 4) = 净利润
Cells(1 + i, 5) = 最大回撤
Cells(1 + i, 6) = 收益风险比
rs.Close
Next
汇总初始权益 = 5000000 * 2
汇总最大权益 = 0
汇总回撤 = 0
汇总最大回撤 = 0
sql = "select sum(当前权益),日期 from 当前权益 group by 日期 having 日期>=cdate(\'2010-04-16\') order by 日期"
rs.Open sql, cn, 3, 1
Do While Not rs.EOF
汇总当前权益 = rs(0)
If 汇总当前权益 > 汇总最大权益 Then
汇总最大权益 = 汇总当前权益
Else
汇总回撤 = 汇总最大权益 - 汇总当前权益
If 汇总回撤 > 汇总最大回撤 Then
汇总最大回撤 = 汇总回撤
End If
End If
If 汇总最大回撤 >= 4000000 Then
MsgBox rs(1)
End If
rs.MoveNext
Loop
汇总净利润 = 汇总当前权益 - 汇总初始权益
汇总收益风险比 = 汇总净利润 / 汇总最大回撤
Cells(12, 4) = 汇总净利润
Cells(12, 5) = 汇总最大回撤
Cells(12, 6) = 汇总收益风险比
rs.Close
End Sub
Private Sub test()
Cells(3, 3) = "cccccc"
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim index As Integer
Dim stklabels(1 To 27) As String
Dim initialassets(1 To 27) As Double
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 初始权益"
rs.Open sql, cn, 3, 1
\'index = rs.RecordCount
For i = 1 To rs.RecordCount
stklabels(i) = rs(0)
initialassets(i) = rs(1)
rs.MoveNext
Next
rs.Close
Cells(3, 3) = "bbbbb"
For i = 1 To 10
Cells(1 + i, 1) = stklabels(i)
sql = "select min(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\'"
rs.Open sql, cn, 3, 1
Cells(1 + i, 2) = rs(0)
rs.Close
sql = "select max(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\'"
rs.Open sql, cn, 3, 1
Cells(1 + i, 3) = rs(0)
rs.Close
Next
End Sub
Private Sub 提取数据_Click()
Application.ScreenUpdating = False
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 设置"
rs.Open sql, cn, 3, 1
测试品种 = rs(0)
测试周期 = rs(1)
测试时间 = rs(2)
初始资金 = rs(3)
保证金率 = rs(4)
佣金滑点 = rs(5)
rs.Close
sql = "select 权益 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
期末权益 = rs(0)
盈利金额 = 期末权益 - 初始资金
收益率 = 盈利金额 / 初始资金
rs.Close
sql = "select 平仓盈亏 from 权益"
rs.Open sql, cn, 3, 1
连赢 = 0
连亏 = 0
最大连赢 = 0
最大连亏 = 0
Do While Not rs.EOF
平仓盈亏 = rs(0)
If 平仓盈亏 > 0 Then
连赢 = 连赢 + 1
连亏 = 0
If 连赢 > 最大连赢 Then
最大连赢 = 连赢
End If
End If
If 平仓盈亏 = 0 Then
连赢 = 0
连亏 = 0
End If
If 平仓盈亏 < 0 Then
连亏 = 连亏 + 1
连赢 = 0
If 连亏 > 最大连亏 Then
最大连亏 = 连亏
End If
End If
rs.MoveNext
Loop
rs.Close
sql = "select 权益 from 权益"
rs.Open sql, cn, 3, 1
最大回撤 = 0
回撤率 = 0
最大权益 = 0
Do While Not rs.EOF
权益 = rs(0)
If 权益 > 最大权益 Then
最大权益 = 权益
End If
回撤 = 权益 - 最大权益
If 回撤 < 最大回撤 Then
最大回撤 = 回撤
End If
rs.MoveNext
Loop
rs.Close
sql = "select count(1) from (select distinct 开仓日期 from 交易明细)"
rs.Open sql, cn, 3, 1
交易天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
盈利天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
亏损天数 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益"
rs.Open sql, cn, 3, 1
日均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
平均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
平均亏损 = rs(0)
rs.Close
sql = "select count(1) from 权益"
rs.Open sql, cn, 3, 1
观测天数 = rs(0)
rs.Close
sql = "select sum(平仓盈亏) from 交易明细"
rs.Open sql, cn, 3, 1
毛利润 = rs(0)
rs.Close
sql = "select sum(总手续费) from 交易明细"
rs.Open sql, cn, 3, 1
手续费 = rs(0)
rs.Close
成功率 = 盈利天数 / 交易天数
回撤率 = 最大回撤 / 最大权益
回报率 = 平均盈利 / -平均亏损
空仓天数 = 观测天数 - 交易天数
出击率 = 交易天数 / 观测天数
净利润 = 毛利润 - 手续费
If 毛利润 > 0 Then
佣金率 = 手续费 / 毛利润
Else
佣金率 = 0
End If
Cells(3, 2) = 测试品种
Cells(3, 4) = 测试周期
Cells(3, 6) = 测试时间
Cells(3, 8) = 初始资金
Cells(3, 10) = 保证金率
Cells(3, 12) = 佣金滑点
Cells(6, 2) = 初始资金
Cells(7, 2) = 期末权益
Cells(8, 2) = 盈利金额
Cells(9, 2) = 收益率
Cells(6, 4) = 最大连赢
Cells(7, 4) = 最大连亏
Cells(8, 4) = 最大回撤
Cells(9, 4) = 回撤率
Cells(6, 6) = 交易天数
Cells(7, 6) = 盈利天数
Cells(8, 6) = 亏损天数
Cells(9, 6) = 成功率
Cells(6, 8) = 日均盈利
Cells(7, 8) = 平均盈利
Cells(8, 8) = 平均亏损
Cells(9, 8) = 回报率
Cells(6, 10) = 观测天数
Cells(7, 10) = 交易天数
Cells(8, 10) = 空仓天数
Cells(9, 10) = 出击率
Cells(6, 12) = 毛利润
Cells(7, 12) = 净利润
Cells(8, 12) = 手续费
Cells(9, 12) = 佣金率
sql = "select 日期,累计盈亏 from 权益"
rs.Open sql, cn, 3, 1
Range("y1").CopyFromRecordset rs
rs.Close
Range("y:y").NumberFormatLocal = "yyyy/m/d"
Range("z:z").NumberFormatLocal = "￥ #,##0"
Set r = Range("a12:l12")
Dim cht As ChartObject
Set cht = ChartObjects.Add(r.Left, r.Top, r.Width, 200)
cht.Chart.ChartType = xlArea
cht.Chart.ChartStyle = 5
cht.Chart.HasLegend = False
cht.Chart.SetSourceData Source:=Range("$Y:$Y,$Z:$Z")
sql = "select * from 交易明细 order by 开仓日期 desc"
rs.Open sql, cn, 3, 1
h = 30
For i = 1 To rs.RecordCount
Cells(h, 1) = i
Cells(h, 2) = rs(0)
Cells(h, 3) = rs(1)
Cells(h, 4) = rs(2)
Cells(h, 5) = rs(3)
Cells(h, 6) = rs(4)
Cells(h, 7) = rs(5)
Cells(h, 8) = rs(6)
Cells(h, 9) = rs(7)
Cells(h, 10) = rs(8)
Cells(h, 11) = rs(9)
Cells(h, 12) = rs(10)
Cells(h, 2).NumberFormatLocal = "yyyy/m/d"
Cells(h, 4).NumberFormatLocal = "h:mm"
Cells(h, 5).NumberFormatLocal = "￥ #,##0"
Cells(h, 7).NumberFormatLocal = "h:mm"
Cells(h, 8).NumberFormatLocal = "￥ #,##0"
Cells(h, 11).NumberFormatLocal = "￥ #,##0"
Cells(h, 12).NumberFormatLocal = "￥ #,##0"
r = "a" & h & ":" & "l" & h
Range(r).Font.Bold = True
Range(r).HorizontalAlignment = xlCenter
Range(r).Borders.LineStyle = xlContinuous
rs.MoveNext
h = h + 1
Next
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub 复制数据_Click()
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 8 Or s.Type = 12 Then
s.Delete
End If
Next
End Sub
Private Sub 清除数据_Click()
Cells(3, 2).ClearContents
Cells(3, 4).ClearContents
Cells(3, 6).ClearContents
Cells(3, 8).ClearContents
Cells(3, 10).ClearContents
Cells(3, 12).ClearContents
Cells(6, 2).ClearContents
Cells(7, 2).ClearContents
Cells(8, 2).ClearContents
Cells(9, 2).ClearContents
Cells(6, 4).ClearContents
Cells(7, 4).ClearContents
Cells(8, 4).ClearContents
Cells(9, 4).ClearContents
Cells(6, 6).ClearContents
Cells(7, 6).ClearContents
Cells(8, 6).ClearContents
Cells(9, 6).ClearContents
Cells(6, 8).ClearContents
Cells(7, 8).ClearContents
Cells(8, 8).ClearContents
Cells(9, 8).ClearContents
Cells(6, 10).ClearContents
Cells(7, 10).ClearContents
Cells(8, 10).ClearContents
Cells(9, 10).ClearContents
Cells(6, 12).ClearContents
Cells(7, 12).ClearContents
Cells(8, 12).ClearContents
Cells(9, 12).ClearContents
Range("a30:l9999").Clear
On Error Resume Next
ChartObjects(1).Delete
Range("y:z").Clear
End Sub
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim index As Integer
Dim stklabels(1 To 27) As String
Dim initialassets(1 To 27) As Double
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 初始权益"
rs.Open sql, cn, 3, 1
\'index = rs.RecordCount
For i = 1 To rs.RecordCount
stklabels(i) = rs(0)
initialassets(i) = rs(1)
rs.MoveNext
Next
rs.Close
汇总净利润 = 0
汇总最大回撤 = 0
汇总收益风险比 = 0
For i = 1 To 2
初始权益 = 5000000
最大权益 = 0
回撤 = 0
最大回撤 = 0
Cells(1 + i, 1) = stklabels(i)
sql = "select min(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\')"
rs.Open sql, cn, 3, 1
Cells(1 + i, 2) = rs(0)
Cells(1 + i, 2).NumberFormatLocal = "yyyy/m/d"
rs.Close
sql = "select max(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\')"
rs.Open sql, cn, 3, 1
Cells(1 + i, 3) = rs(0)
Cells(1 + i, 3).NumberFormatLocal = "yyyy/m/d"
rs.Close
sql = "select 当前权益 from 当前权益 where 品种=\'" + stklabels(i) + "\' and 日期>=cdate(\'2010-04-16\') order by 日期"
rs.Open sql, cn, 3, 1
Do While Not rs.EOF
当前权益 = rs(0)
If 当前权益 > 最大权益 Then
最大权益 = 当前权益
Else
回撤 = 最大权益 - 当前权益
If 回撤 > 最大回撤 Then
最大回撤 = 回撤
End If
End If
rs.MoveNext
Loop
净利润 = 当前权益 - 初始权益
收益风险比 = 净利润 / 最大回撤
Cells(1 + i, 4) = 净利润
Cells(1 + i, 5) = 最大回撤
Cells(1 + i, 6) = 收益风险比
rs.Close
Next
汇总初始权益 = 5000000 * 2
汇总最大权益 = 0
汇总回撤 = 0
汇总最大回撤 = 0
sql = "select sum(当前权益),日期 from 当前权益 group by 日期 having 日期>=cdate(\'2010-04-16\') order by 日期"
rs.Open sql, cn, 3, 1
Do While Not rs.EOF
汇总当前权益 = rs(0)
If 汇总当前权益 > 汇总最大权益 Then
汇总最大权益 = 汇总当前权益
Else
汇总回撤 = 汇总最大权益 - 汇总当前权益
If 汇总回撤 > 汇总最大回撤 Then
汇总最大回撤 = 汇总回撤
End If
End If
If 汇总最大回撤 >= 4000000 Then
MsgBox rs(1)
End If
rs.MoveNext
Loop
汇总净利润 = 汇总当前权益 - 汇总初始权益
汇总收益风险比 = 汇总净利润 / 汇总最大回撤
Cells(12, 4) = 汇总净利润
Cells(12, 5) = 汇总最大回撤
Cells(12, 6) = 汇总收益风险比
rs.Close
End Sub
Private Sub test()
Cells(3, 3) = "cccccc"
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
Dim index As Integer
Dim stklabels(1 To 27) As String
Dim initialassets(1 To 27) As Double
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 初始权益"
rs.Open sql, cn, 3, 1
\'index = rs.RecordCount
For i = 1 To rs.RecordCount
stklabels(i) = rs(0)
initialassets(i) = rs(1)
rs.MoveNext
Next
rs.Close
Cells(3, 3) = "bbbbb"
For i = 1 To 10
Cells(1 + i, 1) = stklabels(i)
sql = "select min(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\'"
rs.Open sql, cn, 3, 1
Cells(1 + i, 2) = rs(0)
rs.Close
sql = "select max(日期) from 当前权益 where 品种=\'" + stklabels(i) + "\'"
rs.Open sql, cn, 3, 1
Cells(1 + i, 3) = rs(0)
rs.Close
Next
End Sub
Private Sub 提取数据_Click()
Application.ScreenUpdating = False
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 设置"
rs.Open sql, cn, 3, 1
测试品种 = rs(0)
测试周期 = rs(1)
测试时间 = rs(2)
初始资金 = rs(3)
保证金率 = rs(4)
佣金滑点 = rs(5)
rs.Close
sql = "select 权益 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
期末权益 = rs(0)
盈利金额 = 期末权益 - 初始资金
收益率 = 盈利金额 / 初始资金
rs.Close
sql = "select 平仓盈亏 from 权益"
rs.Open sql, cn, 3, 1
连赢 = 0
连亏 = 0
最大连赢 = 0
最大连亏 = 0
Do While Not rs.EOF
平仓盈亏 = rs(0)
If 平仓盈亏 > 0 Then
连赢 = 连赢 + 1
连亏 = 0
If 连赢 > 最大连赢 Then
最大连赢 = 连赢
End If
End If
If 平仓盈亏 = 0 Then
连赢 = 0
连亏 = 0
End If
If 平仓盈亏 < 0 Then
连亏 = 连亏 + 1
连赢 = 0
If 连亏 > 最大连亏 Then
最大连亏 = 连亏
End If
End If
rs.MoveNext
Loop
rs.Close
sql = "select 权益 from 权益"
rs.Open sql, cn, 3, 1
最大回撤 = 0
回撤率 = 0
最大权益 = 0
Do While Not rs.EOF
权益 = rs(0)
If 权益 > 最大权益 Then
最大权益 = 权益
End If
回撤 = 权益 - 最大权益
If 回撤 < 最大回撤 Then
最大回撤 = 回撤
End If
rs.MoveNext
Loop
rs.Close
sql = "select count(1) from (select distinct 开仓日期 from 交易明细)"
rs.Open sql, cn, 3, 1
交易天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
盈利天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
亏损天数 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益"
rs.Open sql, cn, 3, 1
日均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
平均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
平均亏损 = rs(0)
rs.Close
sql = "select count(1) from 权益"
rs.Open sql, cn, 3, 1
观测天数 = rs(0)
rs.Close
sql = "select sum(平仓盈亏) from 交易明细"
rs.Open sql, cn, 3, 1
毛利润 = rs(0)
rs.Close
sql = "select sum(总手续费) from 交易明细"
rs.Open sql, cn, 3, 1
手续费 = rs(0)
rs.Close
成功率 = 盈利天数 / 交易天数
回撤率 = 最大回撤 / 最大权益
回报率 = 平均盈利 / -平均亏损
空仓天数 = 观测天数 - 交易天数
出击率 = 交易天数 / 观测天数
净利润 = 毛利润 - 手续费
If 毛利润 > 0 Then
佣金率 = 手续费 / 毛利润
Else
佣金率 = 0
End If
Cells(3, 2) = 测试品种
Cells(3, 4) = 测试周期
Cells(3, 6) = 测试时间
Cells(3, 8) = 初始资金
Cells(3, 10) = 保证金率
Cells(3, 12) = 佣金滑点
Cells(6, 2) = 初始资金
Cells(7, 2) = 期末权益
Cells(8, 2) = 盈利金额
Cells(9, 2) = 收益率
Cells(6, 4) = 最大连赢
Cells(7, 4) = 最大连亏
Cells(8, 4) = 最大回撤
Cells(9, 4) = 回撤率
Cells(6, 6) = 交易天数
Cells(7, 6) = 盈利天数
Cells(8, 6) = 亏损天数
Cells(9, 6) = 成功率
Cells(6, 8) = 日均盈利
Cells(7, 8) = 平均盈利
Cells(8, 8) = 平均亏损
Cells(9, 8) = 回报率
Cells(6, 10) = 观测天数
Cells(7, 10) = 交易天数
Cells(8, 10) = 空仓天数
Cells(9, 10) = 出击率
Cells(6, 12) = 毛利润
Cells(7, 12) = 净利润
Cells(8, 12) = 手续费
Cells(9, 12) = 佣金率
sql = "select 日期,累计盈亏 from 权益"
rs.Open sql, cn, 3, 1
Range("y1").CopyFromRecordset rs
rs.Close
Range("y:y").NumberFormatLocal = "yyyy/m/d"
Range("z:z").NumberFormatLocal = "￥ #,##0"
Set r = Range("a12:l12")
Dim cht As ChartObject
Set cht = ChartObjects.Add(r.Left, r.Top, r.Width, 200)
cht.Chart.ChartType = xlArea
cht.Chart.ChartStyle = 5
cht.Chart.HasLegend = False
cht.Chart.SetSourceData Source:=Range("$Y:$Y,$Z:$Z")
sql = "select * from 交易明细 order by 开仓日期 desc"
rs.Open sql, cn, 3, 1
h = 30
For i = 1 To rs.RecordCount
Cells(h, 1) = i
Cells(h, 2) = rs(0)
Cells(h, 3) = rs(1)
Cells(h, 4) = rs(2)
Cells(h, 5) = rs(3)
Cells(h, 6) = rs(4)
Cells(h, 7) = rs(5)
Cells(h, 8) = rs(6)
Cells(h, 9) = rs(7)
Cells(h, 10) = rs(8)
Cells(h, 11) = rs(9)
Cells(h, 12) = rs(10)
Cells(h, 2).NumberFormatLocal = "yyyy/m/d"
Cells(h, 4).NumberFormatLocal = "h:mm"
Cells(h, 5).NumberFormatLocal = "￥ #,##0"
Cells(h, 7).NumberFormatLocal = "h:mm"
Cells(h, 8).NumberFormatLocal = "￥ #,##0"
Cells(h, 11).NumberFormatLocal = "￥ #,##0"
Cells(h, 12).NumberFormatLocal = "￥ #,##0"
r = "a" & h & ":" & "l" & h
Range(r).Font.Bold = True
Range(r).HorizontalAlignment = xlCenter
Range(r).Borders.LineStyle = xlContinuous
rs.MoveNext
h = h + 1
Next
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub 复制数据_Click()
ActiveSheet.Copy after:=Sheets(Sheets.Count)
Dim s As Shape
For Each s In ActiveSheet.Shapes
If s.Type = 8 Or s.Type = 12 Then
s.Delete
End If
Next
End Sub
Private Sub 清除数据_Click()
Cells(3, 2).ClearContents
Cells(3, 4).ClearContents
Cells(3, 6).ClearContents
Cells(3, 8).ClearContents
Cells(3, 10).ClearContents
Cells(3, 12).ClearContents
Cells(6, 2).ClearContents
Cells(7, 2).ClearContents
Cells(8, 2).ClearContents
Cells(9, 2).ClearContents
Cells(6, 4).ClearContents
Cells(7, 4).ClearContents
Cells(8, 4).ClearContents
Cells(9, 4).ClearContents
Cells(6, 6).ClearContents
Cells(7, 6).ClearContents
Cells(8, 6).ClearContents
Cells(9, 6).ClearContents
Cells(6, 8).ClearContents
Cells(7, 8).ClearContents
Cells(8, 8).ClearContents
Cells(9, 8).ClearContents
Cells(6, 10).ClearContents
Cells(7, 10).ClearContents
Cells(8, 10).ClearContents
Cells(9, 10).ClearContents
Cells(6, 12).ClearContents
Cells(7, 12).ClearContents
Cells(8, 12).ClearContents
Cells(9, 12).ClearContents
Range("a30:l9999").Clear
On Error Resume Next
ChartObjects(1).Delete
Range("y:z").Clear
End Sub
-- 发布时间：2011/12/18 12:52:07
--
Dim account As String
Private Sub 写数据库_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim fso As New Scripting.FileSystemObject
Dim mypath As String
Dim i As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
On Error Resume Next
cn.Execute ("drop table 账户")
cn.Execute ("drop table 权益")
cn.Execute ("drop table 交易明细")
cn.Execute ("drop table 设置")
cn.Execute ("create table 账户(名称 text,开始时间 datetime,结束日期 datetime,初始资金 number,期末权益 number,累计盈亏 number)")
cn.Execute ("create table 权益(日期 datetime,权益 number,平仓盈亏 number,累计盈亏 number,账户 text)")
cn.Execute ("create table 交易明细(开仓日期 datetime,合约名称 text,开仓时间 datetime,开仓价格 number,交易类型 text,平仓时间 datetime,平仓价格 number,盈亏点数 number,交易手数 number,总手续费 number,平仓盈亏 number,账户 text)")
If 一号账户.Value = True Then
account = "一号账户"
mypath = "e:\\Trade\\Account1\\"
ElseIf 二号账户.Value = True Then
account = "二号账户"
mypath = "e:\\Trade\\Account2\\"
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
i = 1
For Each fn In fso.GetFolder(mypath).Files
j = 11
Workbooks.Open fn
Set 客户交易结算日报 = Sheets("客户交易结算日报")
Set 成交明细 = Sheets("成交明细")
Set 平仓明细 = Sheets("平仓明细")
日期 = 客户交易结算日报.Range("h5:h5")
结存 = 客户交易结算日报.Range("c10:c10")
权益 = 客户交易结算日报.Range("h10:h10")
平仓盈亏 = 客户交易结算日报.Range("c12:c12")
手续费 = 客户交易结算日报.Range("c13:c13")
累计盈亏 = 累计盈亏 + 平仓盈亏 - 手续费
账户 = 客户交易结算日报.Range("c5:c5")
If i = 1 Then
sql = "insert into 账户(名称,开始时间,初始资金) values(\'" & account & "\',\'" & 日期 & "\'," & 结存 & ")"
cn.Execute sql
End If
sql = "insert into 权益(日期,权益,平仓盈亏,累计盈亏,账户) values(\'" & 日期 & "\'," & 权益 & "," & 平仓盈亏 & "," & 累计盈亏 & ",\'" & 账户 & "\')"
cn.Execute sql
Do While j < 平仓明细.[A65536].End(xlUp).Row
原成交序号 = 平仓明细.Range("i" & j & ":i" & j)
成交序号 = 平仓明细.Range("b" & j & ":b" & j)
Set r1 = 成交明细.Cells.Find(what:=原成交序号)
Set r2 = 成交明细.Cells.Find(what:=成交序号)
开仓日期 = 日期
合约名称 = 平仓明细.Range("a" & j & ":a" & j)
开仓时间 = 成交明细.Range("c" & r1.Row & ":c" & r1.Row)
开仓价格 = 成交明细.Range("f" & r1.Row & ":f" & r1.Row)
平仓时间 = 成交明细.Range("c" & r2.Row & ":c" & r2.Row)
平仓价格 = 成交明细.Range("f" & r2.Row & ":f" & r2.Row)
If 成交明细.Range("d" & r1.Row & ":d" & r1.Row) = "买" Then
交易类型 = "买"
盈亏点数 = 平仓价格 - 开仓价格
End If
If 成交明细.Range("d" & r1.Row & ":d" & r1.Row) = " 卖" Then
交易类型 = "卖"
盈亏点数 = 开仓价格 - 平仓价格
End If
交易手数 = 平仓明细.Range("f" & j & ":f" & j)
总手续费 = 成交明细.Range("j" & r1.Row & ":j" & r1.Row) + 成交明细.Range("j" & r2.Row & ":j" & r2.Row)
平仓盈亏 = 平仓明细.Range("h" & j & ":h" & j)
j = j + 1
sql = "insert into 交易明细(开仓日期,合约名称,开仓时间,开仓价格,交易类型,平仓时间,平仓价格,盈亏点数,交易手数,总手续费,平仓盈亏,账户) values(\'" & 开仓日期 & "\',\'" & 合约名称 & "\',\'" & 开仓时间 & "\'," & 开仓价格 & ",\'" & 交易类型 & "\',\'" & 平仓时间 & "\'," & 平仓价格 & "," & 盈亏点数 & "," & 交易手数 & "," & 总手续费 & "," & 平仓盈亏 & ",\'" & 账户 & "\')"
cn.Execute sql
Loop
Workbooks(fn.Name).Close
i = i + 1
Next fn
sql = "select 日期,权益,累计盈亏 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
结束日期 = rs(0)
期末权益 = rs(1)
累计盈亏 = rs(2)
rs.Close
sql = "update 账户 set 结束日期=\'" & 结束日期 & "\',期末权益=" & 期末权益 & ",累计盈亏=" & 累计盈亏 & " where 名称=\'" & account & "\'"
cn.Execute sql
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub 提取数据_Click()
Application.ScreenUpdating = False
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 账户"
rs.Open sql, cn, 3, 1
实盘账户 = rs(0)
开始日期 = rs(1)
结束日期 = rs(2)
初始资金 = rs(3)
期末权益 = rs(4)
累计盈亏 = rs(5)
rs.Close
sql = "select 权益 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
期末权益 = rs(0)
盈利金额 = 期末权益 - 初始资金
收益率 = 盈利金额 / 初始资金
rs.Close
sql = "select 平仓盈亏 from 权益"
rs.Open sql, cn, 3, 1
连赢 = 0
连亏 = 0
最大连赢 = 0
最大连亏 = 0
Do While Not rs.EOF
平仓盈亏 = rs(0)
If 平仓盈亏 > 0 Then
连赢 = 连赢 + 1
连亏 = 0
If 连赢 > 最大连赢 Then
最大连赢 = 连赢
End If
End If
If 平仓盈亏 = 0 Then
连赢 = 0
连亏 = 0
End If
If 平仓盈亏 < 0 Then
连亏 = 连亏 + 1
连赢 = 0
If 连亏 > 最大连亏 Then
最大连亏 = 连亏
End If
End If
rs.MoveNext
Loop
rs.Close
sql = "select 权益 from 权益"
rs.Open sql, cn, 3, 1
最大回撤 = 0
回撤率 = 0
最大权益 = 0
Do While Not rs.EOF
权益 = rs(0)
If 权益 > 最大权益 Then
最大权益 = 权益
End If
回撤 = 权益 - 最大权益
If 回撤 < 最大回撤 Then
最大回撤 = 回撤
End If
rs.MoveNext
Loop
rs.Close
sql = "select count(1) from (select distinct 开仓日期 from 交易明细)"
rs.Open sql, cn, 3, 1
交易天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
盈利天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
亏损天数 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益"
rs.Open sql, cn, 3, 1
日均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
平均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
平均亏损 = rs(0)
If IsNull(平均亏损) Then
平均亏损 = 0
End If
rs.Close
sql = "select count(1) from 权益"
rs.Open sql, cn, 3, 1
观测天数 = rs(0)
rs.Close
sql = "select sum(平仓盈亏) from 交易明细"
rs.Open sql, cn, 3, 1
毛利润 = rs(0)
rs.Close
sql = "select sum(总手续费) from 交易明细"
rs.Open sql, cn, 3, 1
手续费 = rs(0)
rs.Close
成功率 = 盈利天数 / 交易天数
回撤率 = 最大回撤 / 最大权益
If 平均亏损 < 0 Then
回报率 = 平均盈利 / -平均亏损
End If
If 平均亏损 = 0 Then
回报率 = Null
End If
空仓天数 = 观测天数 - 交易天数
出击率 = 交易天数 / 观测天数
净利润 = 毛利润 - 手续费
If 毛利润 > 0 Then
佣金率 = 手续费 / 毛利润
Else
佣金率 = 0
End If
Cells(3, 2) = 实盘账户
Cells(3, 4) = 开始日期
Cells(3, 6) = 结束日期
Cells(3, 8) = 初始资金
Cells(3, 10) = 期末权益
Cells(3, 12) = 累计盈亏
Cells(6, 2) = 初始资金
Cells(7, 2) = 期末权益
Cells(8, 2) = 盈利金额
Cells(9, 2) = 收益率
Cells(6, 4) = 最大连赢
Cells(7, 4) = 最大连亏
Cells(8, 4) = 最大回撤
Cells(9, 4) = 回撤率
Cells(6, 6) = 交易天数
Cells(7, 6) = 盈利天数
Cells(8, 6) = 亏损天数
Cells(9, 6) = 成功率
Cells(6, 8) = 日均盈利
Cells(7, 8) = 平均盈利
Cells(8, 8) = 平均亏损
Cells(9, 8) = 回报率
Cells(6, 10) = 观测天数
Cells(7, 10) = 交易天数
Cells(8, 10) = 空仓天数
Cells(9, 10) = 出击率
Cells(6, 12) = 毛利润
Cells(7, 12) = 净利润
Cells(8, 12) = 手续费
Cells(9, 12) = 佣金率
sql = "select 日期,累计盈亏 from 权益"
rs.Open sql, cn, 3, 1
Range("y1").CopyFromRecordset rs
rs.Close
Range("y:y").NumberFormatLocal = "yyyy/m/d"
Range("z:z").NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Set r = Range("a12:l12")
Dim cht As ChartObject
Set cht = ChartObjects.Add(r.Left, r.Top, r.Width, 200)
cht.Chart.ChartType = xlArea
cht.Chart.ChartStyle = 5
cht.Chart.HasLegend = False
cht.Chart.SetSourceData Source:=Range("$Y:$Y,$Z:$Z")
sql = "select * from 交易明细 order by 开仓日期 desc"
rs.Open sql, cn, 3, 1
h = 30
For i = 1 To rs.RecordCount
Cells(h, 1) = i
Cells(h, 2) = rs(0)
Cells(h, 3) = rs(1)
Cells(h, 4) = rs(2)
Cells(h, 5) = rs(3)
Cells(h, 6) = rs(4)
Cells(h, 7) = rs(5)
Cells(h, 8) = rs(6)
Cells(h, 9) = rs(7)
Cells(h, 10) = rs(8)
Cells(h, 11) = rs(9)
Cells(h, 12) = rs(10)
Cells(h, 2).NumberFormatLocal = "yyyy/m/d"
Cells(h, 4).NumberFormatLocal = "h:mm"
Cells(h, 5).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 7).NumberFormatLocal = "h:mm"
Cells(h, 8).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 11).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 12).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
r = "a" & h & ":" & "l" & h
Range(r).Font.Bold = True
Range(r).HorizontalAlignment = xlCenter
Range(r).Borders.LineStyle = xlContinuous
rs.MoveNext
h = h + 1
Next
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub 清除数据_Click()
Cells(3, 2).ClearContents
Cells(3, 4).ClearContents
Cells(3, 6).ClearContents
Cells(3, 8).ClearContents
Cells(3, 10).ClearContents
Cells(3, 12).ClearContents
Cells(6, 2).ClearContents
Cells(7, 2).ClearContents
Cells(8, 2).ClearContents
Cells(9, 2).ClearContents
Cells(6, 4).ClearContents
Cells(7, 4).ClearContents
Cells(8, 4).ClearContents
Cells(9, 4).ClearContents
Cells(6, 6).ClearContents
Cells(7, 6).ClearContents
Cells(8, 6).ClearContents
Cells(9, 6).ClearContents
Cells(6, 8).ClearContents
Cells(7, 8).ClearContents
Cells(8, 8).ClearContents
Cells(9, 8).ClearContents
Cells(6, 10).ClearContents
Cells(7, 10).ClearContents
Cells(8, 10).ClearContents
Cells(9, 10).ClearContents
Cells(6, 12).ClearContents
Cells(7, 12).ClearContents
Cells(8, 12).ClearContents
Cells(9, 12).ClearContents
Range("a30:l9999").Clear
On Error Resume Next
ChartObjects(1).Delete
Range("y:z").Clear
End Sub
Private Sub 写数据库_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim fso As New Scripting.FileSystemObject
Dim mypath As String
Dim i As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
On Error Resume Next
cn.Execute ("drop table 账户")
cn.Execute ("drop table 权益")
cn.Execute ("drop table 交易明细")
cn.Execute ("drop table 设置")
cn.Execute ("create table 账户(名称 text,开始时间 datetime,结束日期 datetime,初始资金 number,期末权益 number,累计盈亏 number)")
cn.Execute ("create table 权益(日期 datetime,权益 number,平仓盈亏 number,累计盈亏 number,账户 text)")
cn.Execute ("create table 交易明细(开仓日期 datetime,合约名称 text,开仓时间 datetime,开仓价格 number,交易类型 text,平仓时间 datetime,平仓价格 number,盈亏点数 number,交易手数 number,总手续费 number,平仓盈亏 number,账户 text)")
If 一号账户.Value = True Then
account = "一号账户"
mypath = "e:\\Trade\\Account1\\"
ElseIf 二号账户.Value = True Then
account = "二号账户"
mypath = "e:\\Trade\\Account2\\"
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
i = 1
For Each fn In fso.GetFolder(mypath).Files
j = 11
Workbooks.Open fn
Set 客户交易结算日报 = Sheets("客户交易结算日报")
Set 成交明细 = Sheets("成交明细")
Set 平仓明细 = Sheets("平仓明细")
日期 = 客户交易结算日报.Range("h5:h5")
结存 = 客户交易结算日报.Range("c10:c10")
权益 = 客户交易结算日报.Range("h10:h10")
平仓盈亏 = 客户交易结算日报.Range("c12:c12")
手续费 = 客户交易结算日报.Range("c13:c13")
累计盈亏 = 累计盈亏 + 平仓盈亏 - 手续费
账户 = 客户交易结算日报.Range("c5:c5")
If i = 1 Then
sql = "insert into 账户(名称,开始时间,初始资金) values(\'" & account & "\',\'" & 日期 & "\'," & 结存 & ")"
cn.Execute sql
End If
sql = "insert into 权益(日期,权益,平仓盈亏,累计盈亏,账户) values(\'" & 日期 & "\'," & 权益 & "," & 平仓盈亏 & "," & 累计盈亏 & ",\'" & 账户 & "\')"
cn.Execute sql
Do While j < 平仓明细.[A65536].End(xlUp).Row
原成交序号 = 平仓明细.Range("i" & j & ":i" & j)
成交序号 = 平仓明细.Range("b" & j & ":b" & j)
Set r1 = 成交明细.Cells.Find(what:=原成交序号)
Set r2 = 成交明细.Cells.Find(what:=成交序号)
开仓日期 = 日期
合约名称 = 平仓明细.Range("a" & j & ":a" & j)
开仓时间 = 成交明细.Range("c" & r1.Row & ":c" & r1.Row)
开仓价格 = 成交明细.Range("f" & r1.Row & ":f" & r1.Row)
平仓时间 = 成交明细.Range("c" & r2.Row & ":c" & r2.Row)
平仓价格 = 成交明细.Range("f" & r2.Row & ":f" & r2.Row)
If 成交明细.Range("d" & r1.Row & ":d" & r1.Row) = "买" Then
交易类型 = "买"
盈亏点数 = 平仓价格 - 开仓价格
End If
If 成交明细.Range("d" & r1.Row & ":d" & r1.Row) = " 卖" Then
交易类型 = "卖"
盈亏点数 = 开仓价格 - 平仓价格
End If
交易手数 = 平仓明细.Range("f" & j & ":f" & j)
总手续费 = 成交明细.Range("j" & r1.Row & ":j" & r1.Row) + 成交明细.Range("j" & r2.Row & ":j" & r2.Row)
平仓盈亏 = 平仓明细.Range("h" & j & ":h" & j)
j = j + 1
sql = "insert into 交易明细(开仓日期,合约名称,开仓时间,开仓价格,交易类型,平仓时间,平仓价格,盈亏点数,交易手数,总手续费,平仓盈亏,账户) values(\'" & 开仓日期 & "\',\'" & 合约名称 & "\',\'" & 开仓时间 & "\'," & 开仓价格 & ",\'" & 交易类型 & "\',\'" & 平仓时间 & "\'," & 平仓价格 & "," & 盈亏点数 & "," & 交易手数 & "," & 总手续费 & "," & 平仓盈亏 & ",\'" & 账户 & "\')"
cn.Execute sql
Loop
Workbooks(fn.Name).Close
i = i + 1
Next fn
sql = "select 日期,权益,累计盈亏 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
结束日期 = rs(0)
期末权益 = rs(1)
累计盈亏 = rs(2)
rs.Close
sql = "update 账户 set 结束日期=\'" & 结束日期 & "\',期末权益=" & 期末权益 & ",累计盈亏=" & 累计盈亏 & " where 名称=\'" & account & "\'"
cn.Execute sql
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Private Sub 提取数据_Click()
Application.ScreenUpdating = False
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim sql As String
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=e:\\Trade\\Report\\Report.mdb"
sql = "select * from 账户"
rs.Open sql, cn, 3, 1
实盘账户 = rs(0)
开始日期 = rs(1)
结束日期 = rs(2)
初始资金 = rs(3)
期末权益 = rs(4)
累计盈亏 = rs(5)
rs.Close
sql = "select 权益 from 权益 where 日期=(select max(日期) from 权益)"
rs.Open sql, cn, 3, 1
期末权益 = rs(0)
盈利金额 = 期末权益 - 初始资金
收益率 = 盈利金额 / 初始资金
rs.Close
sql = "select 平仓盈亏 from 权益"
rs.Open sql, cn, 3, 1
连赢 = 0
连亏 = 0
最大连赢 = 0
最大连亏 = 0
Do While Not rs.EOF
平仓盈亏 = rs(0)
If 平仓盈亏 > 0 Then
连赢 = 连赢 + 1
连亏 = 0
If 连赢 > 最大连赢 Then
最大连赢 = 连赢
End If
End If
If 平仓盈亏 = 0 Then
连赢 = 0
连亏 = 0
End If
If 平仓盈亏 < 0 Then
连亏 = 连亏 + 1
连赢 = 0
If 连亏 > 最大连亏 Then
最大连亏 = 连亏
End If
End If
rs.MoveNext
Loop
rs.Close
sql = "select 权益 from 权益"
rs.Open sql, cn, 3, 1
最大回撤 = 0
回撤率 = 0
最大权益 = 0
Do While Not rs.EOF
权益 = rs(0)
If 权益 > 最大权益 Then
最大权益 = 权益
End If
回撤 = 权益 - 最大权益
If 回撤 < 最大回撤 Then
最大回撤 = 回撤
End If
rs.MoveNext
Loop
rs.Close
sql = "select count(1) from (select distinct 开仓日期 from 交易明细)"
rs.Open sql, cn, 3, 1
交易天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
盈利天数 = rs(0)
rs.Close
sql = "select count(1) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
亏损天数 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益"
rs.Open sql, cn, 3, 1
日均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏>0"
rs.Open sql, cn, 3, 1
平均盈利 = rs(0)
rs.Close
sql = "select avg(平仓盈亏) from 权益 where 平仓盈亏<0"
rs.Open sql, cn, 3, 1
平均亏损 = rs(0)
If IsNull(平均亏损) Then
平均亏损 = 0
End If
rs.Close
sql = "select count(1) from 权益"
rs.Open sql, cn, 3, 1
观测天数 = rs(0)
rs.Close
sql = "select sum(平仓盈亏) from 交易明细"
rs.Open sql, cn, 3, 1
毛利润 = rs(0)
rs.Close
sql = "select sum(总手续费) from 交易明细"
rs.Open sql, cn, 3, 1
手续费 = rs(0)
rs.Close
成功率 = 盈利天数 / 交易天数
回撤率 = 最大回撤 / 最大权益
If 平均亏损 < 0 Then
回报率 = 平均盈利 / -平均亏损
End If
If 平均亏损 = 0 Then
回报率 = Null
End If
空仓天数 = 观测天数 - 交易天数
出击率 = 交易天数 / 观测天数
净利润 = 毛利润 - 手续费
If 毛利润 > 0 Then
佣金率 = 手续费 / 毛利润
Else
佣金率 = 0
End If
Cells(3, 2) = 实盘账户
Cells(3, 4) = 开始日期
Cells(3, 6) = 结束日期
Cells(3, 8) = 初始资金
Cells(3, 10) = 期末权益
Cells(3, 12) = 累计盈亏
Cells(6, 2) = 初始资金
Cells(7, 2) = 期末权益
Cells(8, 2) = 盈利金额
Cells(9, 2) = 收益率
Cells(6, 4) = 最大连赢
Cells(7, 4) = 最大连亏
Cells(8, 4) = 最大回撤
Cells(9, 4) = 回撤率
Cells(6, 6) = 交易天数
Cells(7, 6) = 盈利天数
Cells(8, 6) = 亏损天数
Cells(9, 6) = 成功率
Cells(6, 8) = 日均盈利
Cells(7, 8) = 平均盈利
Cells(8, 8) = 平均亏损
Cells(9, 8) = 回报率
Cells(6, 10) = 观测天数
Cells(7, 10) = 交易天数
Cells(8, 10) = 空仓天数
Cells(9, 10) = 出击率
Cells(6, 12) = 毛利润
Cells(7, 12) = 净利润
Cells(8, 12) = 手续费
Cells(9, 12) = 佣金率
sql = "select 日期,累计盈亏 from 权益"
rs.Open sql, cn, 3, 1
Range("y1").CopyFromRecordset rs
rs.Close
Range("y:y").NumberFormatLocal = "yyyy/m/d"
Range("z:z").NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Set r = Range("a12:l12")
Dim cht As ChartObject
Set cht = ChartObjects.Add(r.Left, r.Top, r.Width, 200)
cht.Chart.ChartType = xlArea
cht.Chart.ChartStyle = 5
cht.Chart.HasLegend = False
cht.Chart.SetSourceData Source:=Range("$Y:$Y,$Z:$Z")
sql = "select * from 交易明细 order by 开仓日期 desc"
rs.Open sql, cn, 3, 1
h = 30
For i = 1 To rs.RecordCount
Cells(h, 1) = i
Cells(h, 2) = rs(0)
Cells(h, 3) = rs(1)
Cells(h, 4) = rs(2)
Cells(h, 5) = rs(3)
Cells(h, 6) = rs(4)
Cells(h, 7) = rs(5)
Cells(h, 8) = rs(6)
Cells(h, 9) = rs(7)
Cells(h, 10) = rs(8)
Cells(h, 11) = rs(9)
Cells(h, 12) = rs(10)
Cells(h, 2).NumberFormatLocal = "yyyy/m/d"
Cells(h, 4).NumberFormatLocal = "h:mm"
Cells(h, 5).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 7).NumberFormatLocal = "h:mm"
Cells(h, 8).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 11).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
Cells(h, 12).NumberFormatLocal = "_ [$￥-804]* #,##0.00_ ;_ [$￥-804]* -#,##0.00_ ;_ [$￥-804]* ""-""??_ ;_ @_ "
r = "a" & h & ":" & "l" & h
Range(r).Font.Bold = True
Range(r).HorizontalAlignment = xlCenter
Range(r).Borders.LineStyle = xlContinuous
rs.MoveNext
h = h + 1
Next
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub 清除数据_Click()
Cells(3, 2).ClearContents
Cells(3, 4).ClearContents
Cells(3, 6).ClearContents
Cells(3, 8).ClearContents
Cells(3, 10).ClearContents
Cells(3, 12).ClearContents
Cells(6, 2).ClearContents
Cells(7, 2).ClearContents
Cells(8, 2).ClearContents
Cells(9, 2).ClearContents
Cells(6, 4).ClearContents
Cells(7, 4).ClearContents
Cells(8, 4).ClearContents
Cells(9, 4).ClearContents
Cells(6, 6).ClearContents
Cells(7, 6).ClearContents
Cells(8, 6).ClearContents
Cells(9, 6).ClearContents
Cells(6, 8).ClearContents
Cells(7, 8).ClearContents
Cells(8, 8).ClearContents
Cells(9, 8).ClearContents
Cells(6, 10).ClearContents
Cells(7, 10).ClearContents
Cells(8, 10).ClearContents
Cells(9, 10).ClearContents
Cells(6, 12).ClearContents
Cells(7, 12).ClearContents
Cells(8, 12).ClearContents
Cells(9, 12).ClearContents
Range("a30:l9999").Clear
On Error Resume Next
ChartObjects(1).Delete
Range("y:z").Clear
End Sub
-- 发布时间：2011/12/18 18:39:07
--
怎么用呢？谢谢！！！