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
加好友 
发短信
Post By：2011/12/18 12:48:09 [只看该作者]
