bitWalk's

参考サイト

2025-01-04

【備忘録】Excel VBA で Parabolic SAR を算出 (2)

Wikipedia より引用、編集

Excel で Parabolic SAR を算出（配列版）

前回、VBA で Parabolic SAR の算出するために、Range オブジェクトで計算に必要な情報が含まれる範囲を指定して処理へ渡しました（過去記事 [1]）。

今回は、Range オブジェクトを処理へ渡す代わりに配列を渡す方法に変えて、処理時間をベンチマークして比較しました。結論を先に言ってしまえば、配列を使った方がやっぱり処理が早かったです。

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

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

VBA でのアプローチ

考え方は前回と同じで、Parabolic SAR の算出に必要な範囲を処理に渡すのですが、今回は Range オブジェクトから Variant 配列へ移してから処理に渡します。

PSAR を算出する範囲

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

以下が、前回の「Range オブジェクト渡し」から「配列渡し」へ変更した PSAR を算出するコードです。前回と同じアルゴリズムですが、配列を扱うことで .Value を付加する必要がなくなった分、すっきりしたコードになりました。

標準モジュール 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 arr As Variant)
    
    
    ' TREND
    If arr(2, P_CLOSE) > arr(1, P_CLOSE) Then
        arr(2, TREND) = 1
    Else
        arr(2, TREND) = -1
    End If
    
    ' EP, the extreme point
    If arr(2, TREND) = 1 Then
        arr(2, EP) = arr(2, P_HIGH)
    Else
        arr(2, EP) = arr(2, P_LOW)
    End If
    
    ' AF, the acceleration factor
    arr(2, AF) = AF_INIT
    
    ' PSAR
    If arr(2, TREND) = 1 Then
        arr(2, PSAR) = arr(2, P_HIGH)
    Else
        arr(2, PSAR) = arr(2, P_LOW)
    End If
    
End Sub


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

動作確認

下記のワークシートのマクロで動作確認をしました。一旦 Range で指定した範囲を Variant 型の配列へコピーして Parabolic SAR の計算。計算が終わったら同じ Range で指定した範囲へ戻しています。

Sheet1 のマクロ TestPSAR

' Column information
Private Const P_HIGH As Integer = 7
Private Const P_LOW As Integer = 8
Private Const P_CLOSE As Integer = 9

Private Const TREND As Integer = 11
Private Const EP As Integer = 12
Private Const AF As Integer = 13
Private Const PSAR As Integer = 14


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

ベンチマーク

前回と同じく、ベンチマークを計測しました。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

0.05849609375

Range オブジェクトを使った前回は、同じベンチマークで約 0.185 秒かかっていたので、配列にすることで 3 倍ちょっと処理が早くなりました。

短い時間を扱っているので時間差で見ると僅かかもしれませんが、3 倍の差は大きいです。本体アプリも配列への変更に取り掛かる必要が出てきました。

サンプルシート

以上のコード、シートを含む Excel ファイルを下記からダウンロードできます。ご参考まで。

sample_psar_2.xlsm

参考サイト

bitWalk's: 【備忘録】Excel VBA で Parabolic SAR を算出 [2024-12-31]

2024-12-31

【備忘録】Excel VBA で Parabolic SAR を算出

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

0.18548828125

約 0.185 秒かかっていますが、実際には、１秒間隔でタイマーを回して実行する処理において、追加された OHLC データ行に対して PSAR を算出するという使い方になります。

このサンプルの場合は 323 行の PSAR を計算しているので、一行あたりの処理時間は約 0.000574 秒になります。感覚的には十分小さいように思えますが、これを基準にして、まだ改善できる余地があるのかひきつづき探求します。

サンプルシート

以上のコード、シートを含む Excel ファイルを下記からダウンロードできます。ご参考まで。

sample_psar.xlsm

参考サイト

2024-12-24

【備忘録】Excel VBA で一定時間間隔の処理

Wikipedia より引用、編集

自分は Linux ユーザーですので、いままで熱心には VBA を利用してきませんでした。ところが Excel 上でなければできないことがあり、やむなく Excel を購入して VBA のプログラミングに取り組んでいます。

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

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

VBA で一定時間間隔の処理

Excel 上において、一定間隔でデータを取得する必要があったので VBA でどうするのかを調べました。その結果、Win32 API の関数を利用する方法が最も用途に合っていたので利用することにしたのですが、自分が理解したことを残しておくために備忘録としてまとめました。

利用する Win32 API

タイマーを開始する SetTimer 関数^[1]と、タイマーを止める KillTimer 関数^[2]を利用します。

SetTimer 関数

UINT_PTR SetTimer(
  [in, optional] HWND      hWnd,
  [in]           UINT_PTR  nIDEvent,
  [in]           UINT      uElapse,
  [in, optional] TIMERPROC lpTimerFunc
);

SetTimer 関数は、指定したタイムアウト値を持つタイマーを作成します。

この関数の実行に成功したとき、hWnd パラメーターが NULL (= 0) であれば、戻り値は新しいタイマーを識別する整数（タイマー ID）になります。

nIDEvent は 0 以外のタイマー ID。 hWnd パラメーターが NULL で nIDEvent が既存のタイマーと一致しない場合は無視されて、新しいタイマー ID が生成されます。uElapse にはタイムアウト値（ミリ秒）を、lpTimerFunc には、タイムアウト値が経過したときに実行する関数へのポインターを指定します。

アプリケーションは、タイマー ID を KillTimer 関数に渡してタイマーを破棄できます。

KillTimer 関数

BOOL KillTimer(
  [in, optional] HWND     hWnd,
  [in]           UINT_PTR uIDEvent
);

KillTimer 関数は、nIDEvent に指定したタイマーを破棄します。

この関数の実行に成功すると、戻り値は 0 以外（の整数）、失敗した場合は 0 を返します。この関数は BOOL 型ですが実質的に整数型です。

サンプル

参考サイト [3] の「WindowsAPI:SetTimer関数」のサンプルを引用させていただきました。ただし、参考サイト [4] などの情報を参考に、少しだけコードを修正しています。なお、コードは Excel マクロの標準モジュールに記載しています。

Option Explicit

Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, _
                                                       ByVal nIDEvent As LongPtr, _
                                                       ByVal uElapse As Long, _
                                                       ByVal lpTimerFunc As LongPtr) As LongPtr
Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, _
                                                        ByVal nIDEvent As LongPtr) As Long

Public mTimerID As LongPtr

Sub TimerProc()
    If mTimerID = 0 Then End '終了できない時の対策
    On Error Resume Next     'デバッグ出すとExcelが固まるので
    Range("A1") = Now()
End Sub

Sub TimerStart()
    If mTimerID <> 0 Then
        MsgBox "起動済です。"
        Exit Sub
    End If
    mTimerID = SetTimer(0&, 1&, 1000&, AddressOf TimerProc)
End Sub

Sub TimerStop()
    Call KillTimer(0&, mTimerID)
    mTimerID = 0
End Sub

マクロは Excel の［開発］タブから［マクロの表示］ボタンをクリック（あるいは Alt + F8）でマクロ一覧を表示し、TimerStart でタイマーを起動します。タイマーは 1000 ミリ秒間隔で TimerProc マクロを起動します。このマクロは、ワークシートの A1 セルに現在時刻を表示します。セルの書式を変更すると秒単位で更新されていることを確認できます。

タイマーの終了は、TimerStop を実行します。

Excel マクロの実行画面

参考サイト