西西河

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

共:💬31 🌺68
分页树展主题 · 全看首页 上页
/ 3
下页 末页
                • 家园 花鞋!

                  汗哪,现在才发现一直没搞清ACCESS是啥东西,一直把他当成个数据库了,跟JET搞混了。

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

      单均线方法描述:

      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

      元宝推荐:铁手,
分页树展主题 · 全看首页 上页
/ 3
下页 末页


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

Copyright © cchere 西西河