西西河

主题:1-X技术分析测试程序代码帖 -- 牛义缂

共:💬31 🌺68
全看树展主题 · 分页首页 上页
/ 3
下页 末页
家园 1-X技术分析测试程序代码帖

考虑了一下,程序代码还是公布给大家好。也没有什么大用处,懂程序的看着玩吧。

以后的代码都会贴在本帖下,不另开新帖了。

小牛也不保留什么版权,也不保证程序没有错误。使用者自担风险吧!

如果有人改进了代码,也可以贴在这儿给大家分享一下。

顺便感谢自荐测试程序的河友!

通宝推:工大流浪者,

本帖一共被 2 帖 引用 (帖内工具实现)
家园 【代码】双均线(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

元宝推荐:铁手,
家园 不懂程序,送花谢宝。

请问是在哪个证券软件下使用的?

家园 【代码】双均线变种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的收益有时更好有时更坏,大家自己测试总结吧

家园 回花您又得宝了:)
家园 自动交易,小心风险
家园 没有和交易软件连起来,只能起提示作用,但提示也会有风险,

谢谢提醒

家园 coder顶code
家园 回花,恭喜:你意外获得【铢钱】八个

为啥这时候运气这么好呢?现在我仓位很轻,明天一定要买股票!

家园 【代码】单均线(叉收盘线)+ 延迟买卖

单均线方法描述:

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

家园 数据是从哪儿来的呢?

我原来也写过分析程序,不过自己录入数据太痛苦了,就作罢了

家园 【数据下载】有现成的数据,从股票软件中下载就行,方法:

1.比如去招商证券网站(其它证券也可以)下载全能版安装(免费的)

2.从“独立行情”进入(无需登录),然后随便打开哪个股票

3.使用日线的前复权视图,前复权好像快捷键是CTRL+V

4.缩小K线(按下箭头)以显示全部数据

5.“系统”菜单->“数据导出”->EXCEL格式

6.再把导出的EXCEL文件导入到ACCESS中

家园 【代码】EMA(EXPMA)双均线交叉方法

以前谈的均线,都是最简单的一种均线,叫做简单平滑移动平均线(SMA)。对简单平均线的改进方法有多种,影响最大的一种是EXPMA(简称EMA),就是指数平滑移动平均线。这种方法对近期价格加高权重,远期价格加低权重,以更多的反映近期的趋势变化。

注:在通达信类软件中(其它软件没用过),你需要缩小K线图至全部显示,然后再放大到要考察的日期,软件才能正确计算EMA均线。另外,通达信类软件中EMA参数最大只能设置到250日。

---------------------------------------

双EMA均线交叉方法描述:

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, M1 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

'M1:小均线值

For M1 = 5 To 125 Step 5

'M2:大均线值

For M2 = M1 + 5 To 250 Step 5

Call MACL(M1, M2)

Call DEAL(B, S, ST, ET, TX)

'填True时显示所有结果,填False显示特定结果

If False Then

Debug.Print M1, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)

Else

'TRATE>MX:最后一行结果为总收益最大值

'TRATE>5:显示所有总收益大于5的结果

If TRATE > MX Then

Debug.Print M1, M2, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)

MX = TRATE

End If

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(M1 As Long, M2 As Long)

Dim I As Long, T As Long, TMP1 As Currency

ReDim MA1(U1)

MA1(0) = DP1(1, 0)

For I = 1 To U1

MA1(I) = MA1(I - 1) * (M1 - 1) / (M1 + 1) + DP1(1, I) * 2 / (M1 + 1)

Next

ReDim MA2(U1)

MA2(0) = DP1(1, 0)

For I = 1 To U1

MA2(I) = MA2(I - 1) * (M2 - 1) / (M2 + 1) + DP1(1, I) * 2 / (M2 + 1)

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


本帖一共被 1 帖 引用 (帖内工具实现)
家园 【代码】MACD

MACD-DIF/DEA交叉方法描述:

1.买入策略:MACD的DIF线金叉DEA线时,第二天开盘买入。

2.卖出策略:MACD的DIF线死叉DEA线时,第二天开盘卖出。

------------------------

注:

1.通达信类软件中,需要缩小K线图至显示全部历史数据,然后再放大到观察点,软件才能正确计算MACD。

2.通达信类软件中,MACD的三个参数的默认设置最大值只有200。可以通过修改公式来设置更大的值。

------------------------

表结构

字段名 类型 备注

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, 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")

'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", "MA3", "FROM", "TO", "手续费", "总收益", "交易次数"

MX = 0

B = 0

S = 0

'M3:DEA均线值

For M3 = 5 To 300 Step 5

'M1:快EMA均线值

For M1 = 5 To 150 Step 5

'M2:慢EMA均线值

For M2 = M1 + 15 To 300 Step 5

Call MACL(M1, M2, M3)

Call DEAL(B, S, ST, ET, TX)

'填True时显示所有结果,填False显示特定结果

If False Then

Debug.Print M1, M2, M3, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)

Else

'TRATE>MX:最后一行结果为总收益最大值

'TRATE>5:显示所有总收益大于5的结果

If TRATE > MX Then

Debug.Print M1, M2, M3, ST, ET, TX * 100 & "%", TRATE, Int(TIMES / 2)

MX = TRATE

End If

End If

Next

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

Debug.Print "运行完成!"

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 Currency

ReDim MA1(U1)

'TEMP EMA1-MA1()

MA1(0) = DP1(1, 0)

For I = 1 To U1

MA1(I) = MA1(I - 1) * (M1 - 1) / (M1 + 1) + DP1(1, I) * 2 / (M1 + 1)

Next

ReDim MA2(U1)

'TEMP EMA2-MA2()

MA2(0) = DP1(1, 0)

'DIFF-MA1()

MA1(0) = MA1(0) - MA2(0)

For I = 1 To U1

MA2(I) = MA2(I - 1) * (M2 - 1) / (M2 + 1) + DP1(1, I) * 2 / (M2 + 1)

MA1(I) = MA1(I) - MA2(I)

Next

'DEA-MA2()

MA2(0) = MA1(0)

For I = 1 To U1

MA2(I) = MA2(I - 1) * (M3 - 1) / (M3 + 1) + MA1(I) * 2 / (M3 + 1)

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


本帖一共被 1 帖 引用 (帖内工具实现)
家园 咋不直接用VBA+Excel处理数据呢

处理起来应该差不多吧,为啥把数据导入到ACEESS中?

全看树展主题 · 分页首页 上页
/ 3
下页 末页


有趣有益,互惠互利;开阔视野,博采众长。
虚拟的网络,真实的人。天南地北客,相逢皆朋友

Copyright © cchere 西西河