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

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