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

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