主题:1-X技术分析测试程序代码帖 -- 牛义缂
看到还有人对代码感兴趣,就把以前做的KDJ中的KD线的代码贴在这儿,其实是没什么用的。
Option Compare Database
Option Explicit
'数组RD1()存储交易记录,如果程序提示下标越界,需要增加第二维的下标
Public DP1 As Variant, RD1(2, 999) 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, M1 As Long, M2 As Long, M3 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", "HIGH", "LOW")
'ST:测试区域的开始日期(注意您的机器上的日期格式)
'注意:开始日期前面要留足计算均线的日期。例如,如果你要用到200日均线,开始日期前面要有至少200条数据。
ST = #7/2/2005#
'ET:测试区域的终止日期(注意您的机器上的日期格式)
ET = #7/2/2010#
'TX:总手续费(只作用于卖价)
TX = 0.008
'CODE:数据表名称
CODE = "600649"
Call READ1(R1)
Debug.Print " RSV", "K", "D", "FROM", "TO", "手续费", "总收益", "交易次数"
MX = 0
B = 0
S = 0
'M3:RSV
For M3 = 5 To 120 Step 5
'M1:K线
For M1 = 10 To 200 Step 10
'M2:D线
For M2 = 10 To 200 Step 10
Call MACL(M1, M2, M3)
Call DEAL(B, S, ST, ET, TX)
'填True时显示所有结果,填False显示特定结果
If False Then
Debug.Print M3, M1, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)
Else
'TRATE>MX:最后一行结果为总收益最大值
'TRATE>5:显示所有总收益大于5的结果
If TRATE > MX Then
Debug.Print M3, M1, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)
MX = TRATE
End If
End If
Next
'If M1 = 1 Then M1 = 0
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(M1 As Long, M2 As Long, M3 As Long)
Dim I As Long, T As Long, TMP1 As Long, LW As Currency, HT As Currency
ReDim MA2(U1)
'TEMP RSV-MA2()
For T = 0 To M3 - 1
HT = DP1(3, T)
LW = DP1(4, T)
For I = T To 0 Step -1
If DP1(3, I) > HT Then HT = DP1(3, I)
If DP1(4, I) < LW Then LW = DP1(4, I)
Next
MA2(T) = (DP1(1, T) - LW) / (HT - LW) * 100
Next
For T = M3 To U1
If DP1(3, T) > HT Then
HT = DP1(3, T)
Else
If DP1(3, T - M3) = HT Then
HT = 0
For I = T To T - M3 + 1 Step -1
If DP1(3, I) > HT Then HT = DP1(3, I)
Next
End If
End If
If DP1(4, T) < LW Then
LW = DP1(4, T)
Else
If DP1(4, T - M3) = LW Then
LW = 99999
For I = T To T - M3 + 1 Step -1
If DP1(4, I) < LW Then LW = DP1(4, I)
Next
End If
End If
MA2(T) = (DP1(1, T) - LW) / (HT - LW) * 100
Next
ReDim MA1(U1)
'K-MA1()
MA1(0) = 50
For I = 1 To U1
MA1(I) = MA1(I - 1) * (M1 - 1) / M1 + MA2(I) / M1
Next
'D-MA2()
MA2(0) = 50
For I = 1 To U1
MA2(I) = MA2(I - 1) * (M2 - 1) / M2 + MA1(I) / M2
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
- 相关回复 上下关系8
🙂1-X技术分析测试程序代码帖 18 牛义缂 字264 2010-09-20 07:47:33
🙂【代码】KDJ(没有做J线)
🙂非常感谢!等周末看看如何转为Excel, mymajia 字22 2010-12-09 11:50:40
🙂【代码】MACD的有效改进 5 牛义缂 字6668 2010-10-18 21:57:54
🙂【代码】MACD 4 牛义缂 字5899 2010-10-11 12:16:04
🙂【代码】EMA(EXPMA)双均线交叉方法 3 牛义缂 字5710 2010-10-03 20:13:00
🙂ema,ma可以简单用 凡妮娅 字186 2010-10-18 07:18:08
🙂多谢提示,小牛有空测试一下你说的两者并用的方法 牛义缂 字43 2010-10-18 09:26:25