主题：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