您现在的位置:程序化交易>> 期货公式>> 金字塔等>> 其他期货软件知识>>正文内容

[原创]测试报告源码 [金字塔]

  • 咨询内容:

     

    以下内容为程序代码:

    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编辑过]

     

  • 金字塔客服:

    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 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

     

  • 网友回复: 怎么用呢?谢谢!!!

【字体: 】【打印文章】【查看评论

相关文章

    没有相关内容