主题：1-X技术分析测试程序代码帖 -- 牛义缂
家园 【代码】单均线（叉收盘线）+ 延迟买卖 单均线方法描述：
1.买入策略：
如果收盘线向上穿越均线（金叉），则第二天（或延迟几天）开盘买入。如果延迟的几天里又出现死叉，则不买入。如果计划买入的那一天的开盘价低于均线，则延缓一天买入。
2.卖出策略：
如果收盘线向下穿越均线（死叉），则第二天（或延迟几天）开盘卖出。如果延迟的几天里又出现金叉，则不卖出。如果计划卖出的那一天的开盘价高于均线，则延缓一天卖出。
----------------------------------
表结构
字段名 类型 备注
DATE 日期
OPEN 货币 开盘价
HIGH 货币 最高价
LOW 货币 最低价
CLOSE 货币 收盘价
VOL 长整型 成交量
----------------------------------------
'VBA模块1（要设置的参数都在INITIALIZE()子程序中注释出来了）
Option Compare Database
Option Explicit
'数组RD1()存储交易记录，如果程序提示下标越界，需要增加第二维的下标
Public DP1 As Variant, RD1(2, 499) As Variant, U1 As Long, TIMES As Long, MA1() As Currency, TRATE As Currency, CODE As String
Sub INITIALIZE()
Dim R1 As Variant, M As Long, B As Long, S As Long, ST As Date, ET As Date, TX As Currency, MX As Currency
R1 = Array("DATE", "CLOSE", "OPEN")
'ST:测试区域的开始日期（注意您的机器上的日期格式）
'注意:开始日期前面要留足计算均线的日期。例如，如果你要用到200日均线，开始日期前面要有至少200条数据。
ST = #12/2/1997#
'ET:测试区域的终止日期（注意您的机器上的日期格式）
ET = #7/2/2010#
'TX:总手续费（只作用于卖价）
TX = 0.008
'CODE:数据表名称
CODE = "999999"
Call READ1(R1)
Debug.Print " 均线", "FROM", "TO", "第几日买", "第几日卖", "手续费", "总收益", "交易次数"
MX = 0
'M:均线值
For M = 10 To 200 Step 1
'B:买入延迟（如果满足条件后第二天立即买入，则延迟B = 0天）
For B = 0 To 9
'S:卖出延迟（如果满足条件后第二天立即卖出，则延迟S = 0天）
For S = 0 To 9
Call MACL(M)
Call DEAL(B, S, ST, ET, TX)
'填True时显示所有结果，填False显示特定结果
If True Then
Debug.Print M, ST, ET, B + 2, S + 2, TX * 100 & "%", TRATE, Int(TIMES / 2)
Else
'TRATE>MX:最后一行结果为总收益最大值
'TRATE>5:显示所有总收益大于5的结果
If TRATE > MX Then
Debug.Print M, ST, ET, B + 2, S + 2, TX * 100 & "%", TRATE, Int(TIMES / 2)
MX = TRATE
End If
End If
Next
Next
Next
'填True时显示循环中最后一个均线值的交易记录，填False不显示
If False Then
Debug.Print "DATE", "DEAL", "RATIO"
For B = 0 To TIMES - 1
For S = 0 To 2
Debug.Print RD1(S, B),
Next
Debug.Print
Next
End If
End Sub
Sub READ1(R1 As Variant)
Dim CN1 As ADODB.Connection, RST1 As ADODB.Recordset, SPath As String
SPath = Application.VBE.ActiveVBProject.FileName
Set CN1 = New ADODB.Connection
Set RST1 = New ADODB.Recordset
CN1.CursorLocation = adUseClient
CN1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SPath & ";"
RST1.Open "SELECT * FROM " & CODE & " ORDER BY DATE;", CN1, adOpenForwardOnly, adLockReadOnly, adCmdText
RST1.MoveFirst
DP1 = RST1.GetRows(, , R1)
U1 = UBound(DP1, 2)
RST1.Close
CN1.Close
Set RST1 = Nothing
Set CN1 = Nothing
End Sub
Sub MACL(DY1 As Long)
Dim I As Long, T As Long, TMP1 As Currency
ReDim MA1(U1)
TMP1 = 0
For I = 0 To DY1 - 2
TMP1 = TMP1 + DP1(1, I)
MA1(I) = 0
Next
TMP1 = TMP1 + DP1(1, DY1 - 1)
MA1(DY1 - 1) = TMP1 / DY1
For I = DY1 To U1
TMP1 = TMP1 + DP1(1, I) - DP1(1, I - DY1)
MA1(I) = TMP1 / DY1
Next
End Sub
Sub DEAL(DBUY As Long, DSELL As Long, DT1 As Date, DT2 As Date, TAX As Currency)
Dim I As Long, J As Long, D1 As Long, D2 As Long, DBOK As Boolean, DSOK As Boolean, BGT As Boolean
If DT1 > DT2 Then
MsgBox "Wrong Dates!"
Exit Sub
End If
BGT = False
TIMES = 0
TRATE = 1
D1 = D2N(DT1, "S")
D2 = D2N(DT2, "E")
For I = D1 To D2 - 1
If DP1(1, I - 1) <= MA1(I - 1) And DP1(1, I) > MA1(I) Then
If Not BGT Then
If I + DBUY >= D2 Then
I = I + DBUY
Else
DBOK = True
For J = 1 To DBUY
If DP1(1, I + J) < MA1(I + J) Then 'COMPARE CLOSE PRICE
DBOK = False
I = I + J
Exit For
End If
Next
If DBOK Then
I = I + DBUY
Do
If DP1(2, I + 1) > MA1(I + 1) Then 'COMPARE OPEN PRICE
RD1(0, TIMES) = DP1(0, I + 1)
RD1(1, TIMES) = DP1(2, I + 1)
TIMES = TIMES + 1
BGT = True
Exit Do
Else
If DP1(1, I + 1) < MA1(I + 1) Then 'COMPARE CLOSE PRICE
I = I + 1
Exit Do
Else
I = I + 1
End If
End If
Loop
End If
End If
Else
'Stop
End If
Else
If DP1(1, I - 1) >= MA1(I - 1) And DP1(1, I) < MA1(I) Then
If BGT Then
If I + DSELL >= D2 Then
I = I + DSELL
Else
DSOK = True
For J = 1 To DSELL
If DP1(1, I + J) > MA1(I + J) Then
DSOK = False
I = I + J
Exit For
End If
Next
If DSOK Then
I = I + DSELL
Do
If DP1(2, I + 1) < MA1(I + 1) Then
RD1(0, TIMES) = DP1(0, I + 1)
RD1(1, TIMES) = -DP1(2, I + 1)
RD1(2, TIMES) = DP1(2, I + 1) / RD1(1, TIMES - 1) * (1 - TAX)
TRATE = TRATE * RD1(2, TIMES)
TIMES = TIMES + 1
BGT = False
Exit Do
Else
If DP1(1, I + 1) > MA1(I + 1) Then
I = I + 1
Exit Do
Else
I = I + 1
End If
End If
Loop
End If
End If
Else
'Stop
End If
End If
End If
Next
End Sub
Function D2N(DT As Date, DR As String) As Long
Dim J As Long, K As Long, M As Long
J = 0
K = U1
M = Int((K - J) / 2) + J
Do
Select Case DT
Case DP1(0, M)
D2N = M
Exit Function
Case Is < DP1(0, M)
K = M
M = Int((K - J) / 2) + J
Case Else
J = M
M = Int((K - J) / 2) + J
End Select
Loop Until K - J = 1
If DR = "S" Then
If DT > DP1(0, J) Then
D2N = K
Else
D2N = J
End If
Else
If DT < DP1(0, K) Then
D2N = J
Else
D2N = K
End If
End If
End Function
家园 【代码】双均线（ACCESS 2003 + VBA） 双均线方法描述：
1.买入策略：当小均线向上交叉大均线时（金叉），第二天开盘买入。
2.卖出策略：当小均线向下交叉大均线时（死叉），第二天开盘卖出。
----------------------------------
表结构
字段名 类型 备注
DATE 日期
OPEN 货币 开盘价
HIGH 货币 最高价
LOW 货币 最低价
CLOSE 货币 收盘价
VOL 长整型 成交量
----------------------------------------
'VBA模块1（要设置的参数都在INITIALIZE()子程序中注释出来了）
Option Compare Database
Option Explicit
'数组RD1()存储交易记录，如果程序提示下标越界，需要增加第二维的下标
Public DP1 As Variant, RD1(2, 499) As Variant, U1 As Long, TIMES As Long, MA1() As Currency, MA2() As Currency, TRATE As Currency, CODE As String
Sub INITIALIZE()
Dim R1 As Variant, M As Long, M2 As Long, B As Long, S As Long, ST As Date, ET As Date, TX As Currency, MX As Currency
R1 = Array("DATE", "CLOSE", "OPEN")
'ST:测试区域的开始日期（注意您的机器上的日期格式）
'注意:开始日期前面要留足计算均线的日期。例如，如果你要用到200日均线，开始日期前面要有至少200条数据。
ST = #12/2/1997#
'ET:测试区域的终止日期（注意您的机器上的日期格式）
ET = #7/2/2010#
'TX:总手续费（只作用于卖价）
TX = 0.008
'CODE:数据表名称
CODE = "999999"
Call READ1(R1)
Debug.Print " MA1", "MA2", "FROM", "TO", "手续费", "总收益", "交易次数"
MX = 0
B = 0
S = 0
'M:小均线值
For M = 5 To 100 Step 5
'M2:大均线值
For M2 = M + 5 To 200 Step 5
Call MACL(M, M2)
Call DEAL(B, S, ST, ET, TX)
'填True时显示所有结果，填False显示特定结果
If False Then
Debug.Print M, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)
Else
'TRATE>MX:最后一行结果为总收益最大值
'TRATE>5:显示所有总收益大于5的结果
If TRATE > 5 Then Debug.Print M, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2): MX = TRATE
End If
Next
Next
'填True时显示循环中最后一对双均线的交易记录，填False不显示
If False Then
Debug.Print "日期", "正买负卖", "每次收益"
For B = 0 To TIMES - 1
For S = 0 To 2
Debug.Print RD1(S, B),
Next
Debug.Print
Next
End If
End Sub
Sub READ1(R1 As Variant)
Dim CN1 As ADODB.Connection, RST1 As ADODB.Recordset, SPath As String
SPath = Application.VBE.ActiveVBProject.FileName
Set CN1 = New ADODB.Connection
Set RST1 = New ADODB.Recordset
CN1.CursorLocation = adUseClient
CN1.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SPath & ";"
RST1.Open "SELECT * FROM " & CODE & " ORDER BY DATE;", CN1, adOpenForwardOnly, adLockReadOnly, adCmdText
RST1.MoveFirst
DP1 = RST1.GetRows(, , R1)
U1 = UBound(DP1, 2)
RST1.Close
CN1.Close
Set RST1 = Nothing
Set CN1 = Nothing
End Sub
Sub MACL(DY1 As Long, DY2 As Long)
Dim I As Long, T As Long, TMP1 As Currency
ReDim MA1(U1)
TMP1 = 0
For I = 0 To DY1 - 2
TMP1 = TMP1 + DP1(1, I)
MA1(I) = 0
Next
TMP1 = TMP1 + DP1(1, DY1 - 1)
MA1(DY1 - 1) = TMP1 / DY1
For I = DY1 To U1
TMP1 = TMP1 + DP1(1, I) - DP1(1, I - DY1)
MA1(I) = TMP1 / DY1
Next
ReDim MA2(U1)
TMP1 = 0
For I = 0 To DY2 - 2
TMP1 = TMP1 + DP1(1, I)
MA2(I) = 0
Next
TMP1 = TMP1 + DP1(1, DY2 - 1)
MA2(DY2 - 1) = TMP1 / DY2
For I = DY2 To U1
TMP1 = TMP1 + DP1(1, I) - DP1(1, I - DY2)
MA2(I) = TMP1 / DY2
Next
End Sub
Sub DEAL(DBUY As Long, DSELL As Long, DT1 As Date, DT2 As Date, TAX As Currency)
Dim I As Long, J As Long, D1 As Long, D2 As Long, DBOK As Boolean, DSOK As Boolean, BGT As Boolean
If DT1 > DT2 Then
MsgBox "日期错误!"
Exit Sub
End If
BGT = False
TIMES = 0
TRATE = 1
D1 = D2N(DT1, "S")
D2 = D2N(DT2, "E")
For I = D1 To D2 - 1
If MA1(I - 1) <= MA2(I - 1) And MA1(I) > MA2(I) Then
If Not BGT Then
RD1(0, TIMES) = DP1(0, I + 1)
RD1(1, TIMES) = DP1(2, I + 1)
TIMES = TIMES + 1
BGT = True
Else
'Stop
End If
Else
If (MA1(I - 1) >= MA2(I - 1) And MA1(I) < MA2(I)) Then
If BGT Then
RD1(0, TIMES) = DP1(0, I + 1)
RD1(1, TIMES) = -DP1(2, I + 1)
RD1(2, TIMES) = DP1(2, I + 1) / RD1(1, TIMES - 1) * (1 - TAX)
TRATE = TRATE * RD1(2, TIMES)
TIMES = TIMES + 1
BGT = False
Else
'Stop
End If
End If
End If
Next
End Sub
Function D2N(DT As Date, DR As String) As Long
Dim J As Long, K As Long, M As Long
J = 0
K = U1
M = Int((K - J) / 2) + J
Do
Select Case DT
Case DP1(0, M)
D2N = M
Exit Function
Case Is < DP1(0, M)
K = M
M = Int((K - J) / 2) + J
Case Else
J = M
M = Int((K - J) / 2) + J
End Select
Loop Until K - J = 1
If DR = "S" Then
If DT > DP1(0, J) Then
D2N = K
Else
D2N = J
End If
Else
If DT < DP1(0, K) Then
D2N = J
Else
D2N = K
End If
End If
End Function
元宝推荐：铁手,家园 bug 调试中D1的值为0导致错误，因此改D1 = D2N(DT1, "S")为D1 = D2N(DT1, "S")+1，似乎不 应影响结果。尚祈明示。
家园 coder顶code 家园 自动交易，小心风险 家园 没有和交易软件连起来，只能起提示作用，但提示也会有风险， 谢谢提醒
家园 【代码】双均线变种1（提前卖出） 双均线变种1方法描述：
1.买入策略：当小均线向上交叉大均线时（金叉），第二天开盘买入。
2.卖出策略：当小均线向下交叉大均线时（死叉），或当收盘线和大均线死叉时，第二天开盘卖出。
程序：
只需要把原程序中的这一句If (MA1(I - 1) >= MA2(I - 1) And MA1(I) < MA2(I)) Then
替换为If (MA1(I - 1) >= MA2(I - 1) And MA1(I) < MA2(I)) Or (DP1(1, I - 1) >= MA2(I - 1) And DP1(1, I) < MA2(I)) Then
双均线变种1的收益有时更好有时更坏，大家自己测试总结吧
家园 不懂程序，送花谢宝。 请问是在哪个证券软件下使用的？