株式会社シスアナコム

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

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

VBAで株式の時系列情報を取得(改訂版)

      2015/04/19

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

VBAで株式の時系列情報を取得(改訂版)

今週は引き続き過去3年間の株価データを使った分析用のプログラムを作って検証していました。

ただ、200日移動平均を使って検証しようとして気がついたのですが、計算するためには、その前1年ぐらいの株価データが必要。

過去3年間の株価データでは過去2年分しか検証できません。

もう1年分の株価データを取得

2012年以降の時系列データは持っているので、2011年の株価データを取得しようとして、以前紹介した「GetDailyInfoAll」プログラムを実行したところ、うまく取得できない月があることに気がつきました。

調べたところ、ヤフーファイナンスの時系列情報の表示形式が変更されたみたい。

20営業日ごとに改ページして表示されるようになっていました。

1か月20営業日以上存在する月だと、全てのデータが取得できません。

日々時系列情報を取得しているときは問題がないので、全く気がつきませんでした。

時系列情報取得プログラムを修正

そこで株価の時系列情報を取得するプログラムを修正。

これまで1か月毎に株価データを取得していましたが、半月ごとに変更しました。

Sub GetDailyInfoAll(YYYY As Integer, MM As Integer, T As Integer)
'全銘柄の特定の1ヶ月間の始値、高値、安値、終値、出来高を取得する。
'T=0...1日~15日
'T=1...16日~月末

    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    
    Set DB = CurrentDb
    Set RS = DB.OpenRecordset("T_株式_基本情報", dbOpenTable)
    
    Do Until RS.EOF
        Call GetDailyInfo(RS![銘柄コード], YYYY, MM, T)
        DoEvents
        RS.MoveNext
    Loop

End Sub
Sub GetDailyInfo(CD As String, YYYY As Integer, MM As Integer, T As Integer)
'指定した銘柄の特定の年月1ヶ月間の始値、高値、安値、終値、出来高を取得する。
'T=0...1日~15日
'T=1...16日~月末

    Dim HTMLSRC As String
    Dim I As Integer

    HTMLSRC = GetHttpDocFromYahooDaily(CD, YYYY, MM, T)
    'YAHOOファイナンスの株価一覧(1日~15日/16日~末日)を取得する
    
    If HTMLSRC <> "" Then
    '検索対象期間に株価情報が存在する場合
        
        If T = 0 Then
            For I = 1 To 15
            '1日~15日までループ
                Call GetDailyInfoSub(HTMLSRC, CD, YYYY, MM, I)
            Next I
        ElseIf T = 1 Then
            For I = 16 To 31
            '16日~末日までループ
                Call GetDailyInfoSub(HTMLSRC, CD, YYYY, MM, I)
            Next I
        End If
        
    End If

End Sub
Sub GetDailyInfoSub(HTMLSRC As String, CD As String, YYYY As Integer, MM As Integer, DD As Integer)

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

    Dim Nengappi As String
    Dim YYYYMMDD As Date
    Dim DSTR As String
    
    Dim Hajimene As Currency
    Dim Takane As Currency
    Dim Yasune As Currency
    Dim Owarine As Currency
    Dim Dekidaka As Currency
    Dim ChoOwarine As Currency
    Dim ChoRitsu As Currency
    
    Dim POSS As Long
    Dim POSE As Long
    
    Dim S As String
    
    If IsDate(CStr(YYYY) & "/" & CStr(MM) & "/" & CStr(DD)) Then
    '日付文字列として正しいなら以下の処理を実施
                
        YYYYMMDD = DateSerial(YYYY, MM, DD)
        '日付文字列を作成
                
        If IsMarket(YYYYMMDD) Then
        '市場開催日であれば、レコードを作成/編集する
                
            Set DB = CurrentDb
            Set RS = DB.OpenRecordset("T_株式_日々情報", dbOpenTable)
            RS.Index = "PrimaryKey"

            With RS
                
            .Seek "=", CD, CDate(YYYYMMDD)
            If .NoMatch Then
                .AddNew
                ![銘柄コード] = CD
                ![年月日] = YYYYMMDD
            Else
                .Edit
            End If
            '日々情報レコードがすでに存在するかチェック。
            '存在しなければレコードを新規に作成、存在すれば編集。
                
            Nengappi = CStr(Year(YYYYMMDD)) & "年" & CStr(Month(YYYYMMDD)) & "月" & CStr(Day(YYYYMMDD)) & "日"
            POSS = InStr(1, HTMLSRC, "td>" & Nengappi, vbBinaryCompare)
            '日付文字列を作成して、HTMLソースを検索する
                        
            If POSS > 0 Then
            '株価データが存在する?(市場がお休みの日や売買が成立しない日もある)
                
                If InStr(1, Mid(HTMLSRC, POSS, 100), "分割:", vbBinaryCompare) > 0 Then
                    POSS = InStr(POSS + 1, HTMLSRC, "td>" & Nengappi, vbBinaryCompare)
                End If
                '株式分割表示行であれば読み飛ばす
        
                If POSS > 0 Then
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then Hajimene = CCur(S) Else Hajimene = 0
                    '始値を抽出
                    
                    POSS = POSE
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then Takane = CCur(S) Else Takane = 0
                    '高値を抽出
                    
                    POSS = POSE
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then Yasune = CCur(S) Else Yasune = 0
                    '安値を抽出
                    
                    POSS = POSE
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then Owarine = CCur(S) Else Owarine = 0
                    '終値を抽出
                    
                    POSS = POSE
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then Dekidaka = CCur(S) Else Dekidaka = 0
                    '出来高を抽出
                    
                    POSS = POSE
                    POSS = InStr(POSS, HTMLSRC, "<td>", vbBinaryCompare) + 4
                    POSE = InStr(POSS, HTMLSRC, "</td>", vbBinaryCompare)
                    S = Mid(HTMLSRC, POSS, POSE - POSS)
                    If IsNumeric(S) Then ChoOwarine = CCur(S) Else ChoOwarine = 0
                    '調整後終値を抽出
                    
                    If ChoOwarine <> 0 And Owarine <> ChoOwarine Then
                        ChoRitsu = Owarine / ChoOwarine
                        Hajimene = Hajimene / ChoRitsu
                        Takane = Takane / ChoRitsu
                        Yasune = Yasune / ChoRitsu
                        Owarine = Owarine / ChoRitsu
                        Dekidaka = Dekidaka * ChoRitsu
                    End If
                    '調整率を計算して始値、高値、安値、終値、出来高を調整する
                    
                    ![始値] = Hajimene
                    ![高値] = Takane
                    ![安値] = Yasune
                    ![終値] = Owarine
                    ![出来高] = Dekidaka
                Else
                '株価データが存在しない?
                    ![始値] = 0
                    ![高値] = 0
                    ![安値] = 0
                    ![終値] = 0
                    ![出来高] = 0
                End If
                
            Else
            '株価データが存在しない?
                ![始値] = 0
                ![高値] = 0
                ![安値] = 0
                ![終値] = 0
                ![出来高] = 0
            End If
            
            .Update
            'レコードを更新する
                    
            End With
                    
        End If
    End If

End Sub
Function GetHttpDocFromYahooDaily(CD As String, YYYY As Integer, MM As Integer, T As Integer) As String
'指定した銘柄コードのYAHOOファイナンスのHTMLソース(年月の株価一覧情報)を返す
'存在しなければ空文字列を返す
'T=0...1日~15日
'T=1...16日~月末

    Dim HTMLSRC As String
    Dim YMD As Date
    Dim DD As Integer
    
    YMD = DateSerial(YYYY, MM + 1, 0)
    '月末年月日を取得
    DD = Day(YMD)
    '月末日を取得

    If T = 0 Then
        HTMLSRC = GetHttpDoc("http://info.finance.yahoo.co.jp/history/?code=" & CD & "&sy=" & YYYY & "&sm=" & MM & "&sd=1&ey=" & YYYY & "&em=" & MM & "&ed=15&tm=d&=")
    ElseIf T = 1 Then
        HTMLSRC = GetHttpDoc("http://info.finance.yahoo.co.jp/history/?code=" & CD & "&sy=" & YYYY & "&sm=" & MM & "&sd=16&ey=" & YYYY & "&em=" & MM & "&ed=" & DD & "&tm=d&=")
    End If
    If InStr(HTMLSRC, "この検索期間の価格データはありません。") > 0 Then HTMLSRC = ""
    
    GetHttpDocFromYahooDaily = HTMLSRC

End Function

注意事項(以前と同じ)

頻繁に株価情報を取得するプログラムを実行するとヤフーファイナンスに負荷をかけてしまいます

連続で株価情報を取得するプログラムを実行することは止めて下さい。

場合によっては、ヤフーファイナンスに接続できなくなります

全ての時系列情報を取得するプログラムを連続で実行する、つまり、1か月分の時系列情報を取得しようとすると、ほぼ確実にヤフーファイナンスから締め出しをくらいます。

しばらく時間が経過すると元に戻ると思いますが、そうなっても私は一切責任を取れません。

ご了承下さい。

経験上、午前に1回、午後に1回ぐらいなら大丈夫だと思います。

保証はできません。

VIP倶楽部について

ヤフーファイナンスのHTMLフォーマットが変更される度にACCESSのVBAプログラムを修正するのは面倒だと思います。

もし、お金を払っても良いという方は、ヤフーファイナンスの「VIP倶楽部」に加入すれば、CSV形式で時系列データがダウンロードできます。

CSV形式からACCESSのテーブルにインポートするのは、それほど難しくありません。

それに株価や板情報もリアルタイムで見ることができますし、モーニングスターやフィスコなどが配信するニュースも見ることができます。

金額は月額1980円+税で、初月は無料です。

お財布に余裕のある方は、お試し下さい。

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

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


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

Message

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