自動売買ロボット作成マニュアルを読んで[勢力指数]

こちらは、勢力指数。

Sub force()

lastrow = (Range("B4").End(xlDown).Row) 'B列の一番最後の行番号を代入

Range("AU5:AV65000").ClearContents 'シートをクリーンアップ

length(1) = input_temp(10) '移動平均の期間

'指定したセルを結合し、大きな見出しをつける
Range("AU3:AV3").Select
Selection.MergeCells = True
Selection = "勢力指数"
Selection.HorizontalAlignment = xlCenter

'列に見出しをつける
Range("AU4") = "Force Index"
Range("AV4") = "EMA(" & length(1) & ")"

'勢力指数の値を算出して代入
For i = 6 To lastrow

Cells(i, 47) = (Cells(i, 6) - Cells(i - 1, 6)) * Cells(i, 7)

Next

'勢力指数のEMAの値を算出して代入
For i = length(1) + 4 To lastrow

If i = length(1) + 5 Then

Cells(i, 48) = WorksheetFunction.Average(Range("AU" & i - length(1) + 1, "AU" & i))

Else

Cells(i, 48) = Cells(i - 1, 48) + ((Cells(i, 47) - Cells(i - 1, 48)) * 2 / (1 + length(1)))

End If

Next

'セルの形式を整える
Range("AU5", "AV" & lastrow).NumberFormatLocal = "0"

End Sub

自動売買ロボット作成マニュアルを読んで[RAVI]

いくつか、マクロを書いてみた。
まずは、RAVIを移動平均を取得するマクロ(P.38〜63参照)を参考に作成した。

Sub RAVI()

lastrow = (Range("B4").End(xlDown).Row) 'B列の一番最後の行番号を代入

Range("AO5:AQ65000").ClearContents 'シートをクリーンアップ

length(1) = input_temp(1) '移動平均の期間　1
length(2) = input_temp(2) '移動平均の期間　2

'指定したセルを結合し、大きな見出しをつける
Range("AO3:AQ3").Select
Selection.MergeCells = True
Selection = "RAVI"
Selection.HorizontalAlignment = xlCenter

'移動平均を代入する列に見出しをつける
Range("AO4") = "MA(" & length(1) & ")"
Range("AP4") = "MA(" & length(2) & ")"
Range("AQ4") = "RAVI"

'1つ目の移動平均の値を算出して代入
For i = length(1) + 4 To lastrow

Cells(i, 41) = WorksheetFunction.Average(Range("F" & i - length(1) + 1, "F" & i))

Next

'2つ目の移動平均の値を算出して代入
For i = length(2) + 4 To lastrow

Cells(i, 42) = WorksheetFunction.Average(Range("F" & i - length(2) + 1, "F" & i))

Next

'RAVIの値を算出して代入
For i = length(2) + 4 To lastrow

Cells(i, 43) = Abs(Cells(i, 41) - Cells(i, 42)) / Cells(i, 42)

Next


'セルの形式を整える
Range("AO5", "AP" & lastrow).NumberFormatLocal = "0"
Range("AQ5", "AQ" & lastrow).NumberFormatLocal = "0.00%"

End Sub

ニューラルネット

ニューラルネットは、ヒトの脳の処理と同等のことをコンピュータで行おうとするモデルである。

今回、EXCELで作ってみたのは、４入力、３中間、１出力の３階層構造。
各出力を０〜１にするためにシグモイド関数を使用する。

（１）あらかじめ与えておく
A列：日付
C列：株価
利用する指標４つ

・ファンクション登録（シグモイド関数）
Function sigmf(a)
Application.ScreenUpdating = False
sigmf = 1 / (1 + Exp(-a / 0.5))
End Function

（２）ニューラルネット用重み値
AD1,AE1,AF1,AG1,AH1：中間１計算用
AD2,AE2,AF2,AG2,AH2：中間２計算用
AD3,AE3,AF3,AG3,AH3：中間３計算用
AD4,AE4,AF4,AG4：出力計算用
・初期値用
AD5=RAND()*2-1
として、これをコピーし重み欄に形式を選択で値のみを貼り付ける。
AL8：２乗誤差の平均
AL8=AVERAGE(AL46:AL500)

（３）ニューラルネット計算（４６行目を例に。５００行までコピー）
AC列：教師信号（次の日から５日間で今日より株価が高い日数としてみた）
AC46=COUNTIF(C47:C51,">"&C46)/5
AD列：入力１(各種指標などをいれる）
AE列：入力２
AF列：入力３
AG列：入力４
AH列：中間１
AH46=sigmf($AD46*$AD$1+$AE46*$AE$1+$AF46*$AF$1+$AG46*$AG$1+$AH$1)
AI列：中間２
AI46=sigmf($AD46*$AD$2+$AE46*$AE$2+$AF46*$AF$2+$AG46*$AG$2+$AH$2)
AJ列：中間３
AJ46=sigmf($AD46*$AD$3+$AE46*$AE$3+$AF46*$AF$3+$AG46*$AG$3+$AH$3)
AK列：出力（0.5を上回れば買い、下回れば売り）
AK46=sigmf(AH46*$AD$4+AI46*$AE$4+AJ46*$AF$4+$AH$4)
AL列：誤差
AL46=(AC46-AK46)^2

（４）ソルバーで検索
目的のセル：$AL$8
目標値：最小値
変化させるセル：$AD$1:$AH$3,$AD$4:$AG$4

株価読み込み

Pan Active Market Database(TM) からVBを使ってEXCELに株価を読み込む。分割等があった場合は、現在の価格と連続するように補正する。

入力セル
A2：株価コード
B9：読み込む日数

出力セル
B2:銘柄名
A(12〜）：日付
B(12〜）：始値
C(12〜）：高値
D(12〜）：安値
E(12〜）：終値
F(12〜）：出来高
G(12〜）：分割比

Public Sub kabukaread()
Dim Calendar As New ActiveMarket.Calendar
Dim Prices As New ActiveMarket.Prices
Dim vol As Long
Dim ea As Long
Dim errcount As Integer
Dim exright As Double

errcount = 1
On Error GoTo Err1
Prices.Read Cells(2, 1).Value '読み出し証券コード

Sheet1.Cells(2, 2) = Prices.Name()
Dim DatePos As Long ' 日付位置、Prices.Begin以上Prices.End以下
DatePos = Prices.End

Dim row As Long ' 行番号

Application.Calculation = xlCalculationManual
Range("B12:F1012").Select
Selection.ClearContents

exright = 1# '権利落ち補正
errcount = 0
For row = Cells(9, 2).Value + 12 To 12 Step -1
recov:
On Error GoTo Err1
' 現在のシートのセルに日付と終値を代入
Do
vol = Prices.Volume(DatePos)

DatePos = DatePos - 1
Loop While (vol = 0#) '取引量０の場合は飛ばす

Cells(row, 1) = Calendar.Date(DatePos + 1)
Cells(row, 2) = Prices.Open(DatePos + 1) * exright
Cells(row, 3) = Prices.High(DatePos + 1) * exright
Cells(row, 4) = Prices.Low(DatePos + 1) * exright
Cells(row, 5) = Prices.Close(DatePos + 1) * exright
Cells(row, 6) = Prices.Volume(DatePos + 1)
Cells(row, 7) = Prices.ExRights(DatePos + 1)
exright = exright * Prices.ExRights(DatePos + 1)
Next

Application.Calculation = xlCalculationAutomatic

Exit Sub
Err1:
ea = Err.Number
If Err.Number <> -1056899048 Then '-1056899048=&HC1010018:休日
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
DatePos = DatePos - 1
Resume recov
End Sub