株式会社シスアナコム

情報システムに関することなら、どんなことでも適切に助言いたします!

この投稿は1年以上前に公開されました。
現在では状況や内容が変わっている可能性があります。
ご注意下さい。m(_ _)m

VBAで騰落レシオに近い数字を別テーブルに保存する

      2015/04/19

「ゼロからの週末プログラマー」に掲載していた記事を改訂して掲載しています。

VBAで騰落レシオに近い数字を別テーブルに保存する

だいぶ前に騰落レシオに近い数字を計算するプログラムを作りました。

指定した市場の条件に該当する全銘柄に対してプログラムを実行するので、計算に時間がかかります。

過去の株価データに対して売買の検証作業の条件に加える場合、いちいち計算していたら時間がかかるので、事前によく使いそうな条件で計算しておいて、テーブルに蓄積することを考えました。

作成するテーブル

以下のようなテーブルを作成しました。

テーブル名:T_騰落
年月日:日付/時刻型、主キー
ALL25:通貨型、市場全体の騰落25日
ALL05:通貨型、市場全体の騰落 5日
T125:通貨型、東証1部の騰落25日
T105:通貨型、東証1部の騰落 5日

とりあえず、検証に使えそうな市場全体と東証1部の5日と25日騰落レシオを格納するフィールドを作りました。

指定した年月日のUDRatioを作成する

指定した年月日の騰落レシオを作成してテーブルの指定したフィールドに格納するプログラムです。

Sub CreateUDRatioRecord(YMD As Date, FLD As String)
'指定した年月日のUDRatioを作成してテーブルに格納する
'FLD:フィールド名(ALL25,ALL05,T125,T105)

    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    Dim C As Currency
    
    Set DB = CurrentDb
    Set RS = DB.OpenRecordset("T_騰落", dbOpenTable)
    
    Select Case FLD
        Case "ALL25"
            C = GetUDRatio("", YMD, -24)
        Case "ALL05"
            C = GetUDRatio("", YMD, -4)
        Case "T125"
            C = GetUDRatio("東証1部", YMD, -24)
        Case "T105"
            C = GetUDRatio("東証1部", YMD, -4)
        Case Else
            C = 0
    End Select
    
    If C <> 0 Then
        RS.Index = "PrimaryKey"
        RS.Seek "=", YMD
        If RS.NoMatch Then
            RS.AddNew
            RS![年月日] = YMD
        Else
            RS.Edit
        End If
        RS(FLD) = C
        RS.Update
    End If

End Sub

騰落レシオに近い数字を計算するプログラムも少し修正しました。

Function GetUDRatio(MRKT As String, YMD As Date, TERM As Integer) As Currency
'騰落レシオ(に近い数字)を計算する
'MRKT:市場名(東証1部、東証JQS、マザーズなど)
'YMD :指定年月日
'TERM:対象期間(指定年月日から過去何営業日間かを指定,<=0,>=-24)

    Dim DB As DAO.Database
    Dim RS As DAO.Recordset

    Dim Up As Currency
    Dim Dw As Currency
    Dim Eq As Currency
    Dim C As Currency
    Dim I As Integer
    
    If TERM > 0 Or TERM < -254 Or Not IsMarket(YMD) Then
        GetUDRatio = 0
        Exit Function
    End If
    
    Set DB = CurrentDb
    Set RS = DB.OpenRecordset("T_株式_基本情報", dbOpenTable)
    
    C = 0: Up = 0: Dw = 0: Eq = 0
    
    Do Until RS.EOF
    
        If MRKT = RS![市場] Or MRKT = "" Then
    
            Call SetKabukaInfo(RS![銘柄コード], YMD, TERM - 25)
            '値が付かない日があるので、少し余裕を持って株価データをセット
    
            For I = 0 To TERM Step -1
                If KabukaInfo(I, COwarine) = 0 Or KabukaInfo(I - 1, COwarine) = 0 Then
                    '計算期間に終値が判断できなければ何もしない
                ElseIf KabukaInfo(I, COwarine) > KabukaInfo(I - 1, COwarine) Then
                    Up = Up + 1
                ElseIf KabukaInfo(I, COwarine) < KabukaInfo(I - 1, COwarine) Then
                    Dw = Dw + 1
                Else
                    Eq = Eq + 1
                End If
            Next I
            
        End If
        
        RS.MoveNext
        DoEvents
    Loop
    
    GetUDRatio = Up / Dw * 100

End Function

市場名を指定しない場合は市場全体で計算を行う所と、市場開催日でない場合は0を返す所を修正しました。

過去分の再計算について

このプログラムを日々の株価データを取得した後に実行します。

騰落レシオに近い数字が蓄積されていくので、このテーブルを検索すれば騰落レシオを使った過去データ検証の処理時間を改善する事ができます。

過去の株価データがあれば騰落レシオに近い数字を再計算する事も可能ですが、最新の銘柄基本データを使って過去の数字を再計算することになるので、微妙に変わります。

ただ、騰落レシオという指標は少しぐらい違っていても、なんとかなると思います。

全銘柄の過去データを取得できているのに騰落レシオに近い数字が計算できてない場合、時間がある時に年月日を指定してプログラムを実行すれば再計算できます。

今回はここまで。

 - ACCESSデータベース, 週末プログラマー

↓ブログランキングに参加しています!


ネット・PC(全般) ブログランキングへ
にほんブログ村 IT技術ブログ ITコンサルティングへ
にほんブログ村

Message

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です