bitWalk's: 【備忘録】Excel VBA で Parabolic SAR を算出

VBA, Visual Basic for Applications は、マイクロソフト社が Microsoft Visual Basic を、同社製品の Microsoft Office に搭載したものです。VBA を使用することで、Excel、Access、Word、Outlook、PowerPoint など、Office のアプリケーション・ソフトウェアの機能をカスタマイズしたり、拡張したりすることができます。

Wikipedia より引用、編集

Excel 上で利用する楽天証券のトレーディング・ツール「マーケットスピード II RSS^[1]」（以下 RSS と呼びます）で、デイトレを自動化すべく日々取り組んでいます。RSS には売買機能の API が用意されているので、これを利用することが自動取引を実現する近道と言えます。そのために VBA を使いこなす必要が出てきました。

まずは VBA マクロで１秒間隔のタイマーを回して現在株価を RSS の関数が出力したセルから取得。さらに RSS の API がどんどん Excel に書き込んでくれる OHLC（四本値）データに対して Parabolic SAR を中心としたテクニカル指標を動的に適用して売買判断をさせようとしています。

Parabolic SAR（以下 PSAR と呼びます）の情報は RSS からは得られないので、VBA マクロで算出する必要があります。とりあえずやっつけで用意した PSAR のマクロで今月 12 月からリアルタイムにシミュレーションを重ねてきました。

12 月 30 日の大納会を終え、来年の大発会は 1 月 6 日と長い休みになるので、この間に、やっつけで作った PSAR のマクロを見直すことにしました。

下記の OS 環境で動作確認をしています。

	Microsoft Windows 11 Home	24H2
	Microsoft Excel 2024 MSO	64 ビット

Excel で Parabolic SAR を算出

まず、参考サイト [2] で紹介されていた Excel で PSAR を算出する方法を試してから、このやり方に沿ってやっつけでマクロ化しました。保守のしやすさよりも、とにかく動作させることを優先させたので、直接、何度もセルへアクセスして読み書きをしていました。どうせ一行ずつ算出するのだから、そんなに計算負荷はないだろうとみていました。

VBA でのアプローチ

PSAR を算出するマクロを見直すにあたって、多くのサイトで紹介されているように配列を使って高速化するのが妥当だと思い、検討を始めました。しかし、参考サイト [3] を読んで気が変わりました。Range オブジェクト（変数）を Parabolic SAR を処理するマクロへ参照渡しすれば、変数に関わる処理がシンプルになると考えたからです。

すなわち、下記の赤い領域に新しい PSAR の値 (TREND, EP, AF, PSAR) を算出して書き込むために、赤い領域を含む灰色の領域を PSAR を処理するマクロへ渡します。これだけの領域があれば（使わないセルもありますが）、新しい PSAR を算出できるからです。

PSAR を算出するマクロへ渡す Range

VBAProjects の標準モジュール内に ModPSAR というモジュールを挿入し、２つのマクロ calc_PSAR_1（最初の行の計算用）と calc_PSAR_2（その他の行の計算用）を作りました。

以下が、Range オブジェクト渡しに改善した PSAR を算出するコードです。

標準モジュール ModPSAR

Option Explicit

' Column information
Private Const P_HIGH As Integer = 1
Private Const P_LOW As Integer = 2
Private Const P_CLOSE As Integer = 3

Private Const TREND As Integer = 5
Private Const EP As Integer = 6
Private Const AF As Integer = 7
Private Const PSAR As Integer = 8

' Parameters for Parabolic SAR
Private Const AF_INIT As Double = 0.02
Private Const AF_STEP As Double = 0.02
Private Const AF_MAX As Double = 0.2


'
' PSAR calculation for the 1st row of data
'
Sub calc_PSAR_1(ByRef rng As Range)
    
    
    ' TREND
    If rng(2, P_CLOSE).Value > rng(1, P_CLOSE).Value Then
        rng(2, TREND).Value = 1
    Else
        rng(2, TREND).Value = -1
    End If
    
    ' EP, the extreme point
    If rng(2, TREND).Value = 1 Then
        rng(2, EP).Value = rng(2, P_HIGH).Value
    Else
        rng(2, EP).Value = rng(2, P_LOW).Value
    End If
    
    ' AF, the acceleration factor
    rng(2, AF).Value = AF_INIT
    
    ' PSAR
    If rng(2, TREND).Value = 1 Then
        rng(2, PSAR).Value = rng(2, P_HIGH).Value
    Else
        rng(2, PSAR).Value = rng(2, P_LOW).Value
    End If
    
End Sub


'
' Parabolic SAR calculation for row of data other than the 1st row
'
Sub calc_PSAR_2(ByRef rng As Range)
    
    ' TREND
    If rng(1, TREND) = 1 Then
        If rng(1, PSAR).Value > rng(2, P_LOW).Value Then
            rng(2, TREND).Value = -1
        Else
            rng(2, TREND).Value = 1
        End If
    Else
        If rng(1, PSAR).Value < rng(2, P_HIGH).Value Then
            rng(2, TREND).Value = 1
        Else
            rng(2, TREND).Value = -1
        End If
    End If
    
    ' EP, the extreme point
    If rng(2, TREND).Value = 1 Then
        If rng(1, PSAR).Value > rng(2, P_LOW).Value Then
            rng(2, EP).Value = rng(2, P_LOW).Value
        ElseIf rng(2, P_HIGH).Value > rng(1, EP).Value Then
            rng(2, EP).Value = rng(2, P_HIGH).Value
        Else
            rng(2, EP).Value = rng(1, EP).Value
        End If
    Else
        If rng(1, PSAR).Value < rng(2, P_HIGH).Value Then
            rng(2, EP).Value = rng(2, P_HIGH).Value
        ElseIf rng(2, P_LOW).Value < rng(1, EP).Value Then
            rng(2, EP).Value = rng(2, P_LOW).Value
        Else
            rng(2, EP).Value = rng(1, EP).Value
        End If
    End If
    
    ' AF, the acceleration factor
    If rng(2, TREND).Value <> rng(1, TREND).Value Then
        rng(2, AF).Value = AF_INIT
    Else
        If rng(2, EP).Value <> rng(1, EP).Value And rng(1, AF).Value < AF_MAX Then
            rng(2, AF).Value = rng(1, AF).Value + AF_STEP
        Else
            rng(2, AF).Value = rng(1, AF).Value
        End If
    End If
    
    ' PSAR
    If rng(2, TREND).Value = rng(1, TREND).Value Then
        rng(2, PSAR).Value = rng(1, PSAR).Value + rng(2, AF).Value * (rng(2, EP).Value - rng(1, PSAR).Value)
    Else
        rng(2, PSAR).Value = rng(1, EP).Value
    End If
    
End Sub

エラーが出なかったの気がつきませんでしたが、本ブログにまとめている際に、rng(2, TREND).Value のように .Value を付けるのを忘れていたことに気がつきました。慣れないことをするとミスがでるものです。これでも意図した通りに動いているようですが、オブジェクトを直接比較したりスカラーを代入するのはなんだか変なので後で修正する予定です（年末で既に酒を飲んでいるので、まともに修正できる自信がありません🙇🏻）。修正しました。[2025-01-01]

動作確認

下記のワークシートのマクロで動作確認をしました。

Sheet1 のマクロ TestPSAR

' Column information
Private Const P_HIGH As Integer = 7
Private Const PSAR As Integer = 14


'
' Parabolic SAR のテスト
'
Sub TestPSAR()
    Dim i As Integer
    Dim row_1 As Integer
    Dim range_PSAR As Range
    
    row_1 = 3
    For i = row_1 To row_1 + 323
        Set range_PSAR = Range(Cells(i, P_HIGH), Cells(i + 1, PSAR))
        If i = row_1 Then
            Call calc_PSAR_1(range_PSAR)
        Else
            Call calc_PSAR_2(range_PSAR)
        End If
    Next i
    
End Sub

OHLC データに対して PSAR を一括算出した例（15:23 まで）

ベンチマーク

念のため、ベンチマークを計測しました。100 回算出した平均値を出力しています。

Sheet1 のマクロ Benchmark

'
' ベンチマーク
'
Sub Benchmark()
    Const REPEAT_MAX As Integer = 100
    Dim i As Integer
    Dim timeStart As Double
    Dim timeEnd As Double

    timeStart = Timer
    Do While i < REPEAT_MAX
        Call TestPSAR
        i = i + 1
    Loop
    timeEnd = Timer

    Debug.Print (timeEnd - timeStart) / REPEAT_MAX
End Sub