競馬成績表データベースを作る(データ取得編)
1.概要
競馬成績表データベースを作るの第二弾は、競馬成績表データの一括自動取得を行います。事前準備編で取得済みの
各レース毎のレース成績表リンクリストを使います。そのリストのリンクを順次読み込み、サイトを自動巡回して
成績表データを取得します。取得できるデータ項目は、日付、コード、R番号、競馬場、開催、発走時間、天気、馬場、レース名、コース、距離、単勝、枠連、馬連、馬単、3連単、1着、2着、3着、頭数の
計20項目となります。プログラムは、Excel VBAで作成します。
2.データの取得手順 成績表データ取得手順は、次の手順で行います。 (1)Yahoo競馬レース結果取得.xlsmを起動します。(ダウンロードは、本連載記事の最終回で提供)
(2)成績表データ取得ボタンをクリックします。
(3)ファイル選択ダイアログが開くので、事前取得済みのレース成績表リンクリストを選択します。
(4)データ取得が開始されますので完了するまで待ちます。
(5)レース成績表リンクリストは分割して準備されていると思うので、続いて取得の場合は、
手順(2)から繰り返し実行します。
データベース作成時は、分割取得されたデータを全てマージして利用します。
コード体系は、以下のような体系で構成されています。データ取得時は、このコード番号が
キーとしてURLのパラメータとなります。
今回の記事で紹介してるプログラムは、本シリーズの連載最後にまとめてダウンロード提供する予定としています。 少しずつ記事をアップしていきますので、しばらくお付き合いください。
■関連記事
・Excelでデータベース(SQLite3)を扱う
・複数のファイルをマージする
・競馬成績表データベースを作る(事前準備編)
・競馬成績表データベースを作る(データベース編)
・競馬成績表データベースを作る(ツール－Excel編)
・競馬成績表データベースを作る(ツール－HSP編)
2.データの取得手順 成績表データ取得手順は、次の手順で行います。 (1)Yahoo競馬レース結果取得.xlsmを起動します。(ダウンロードは、本連載記事の最終回で提供)
(2)成績表データ取得ボタンをクリックします。
(3)ファイル選択ダイアログが開くので、事前取得済みのレース成績表リンクリストを選択します。
(4)データ取得が開始されますので完了するまで待ちます。
(5)レース成績表リンクリストは分割して準備されていると思うので、続いて取得の場合は、
手順(2)から繰り返し実行します。
データベース作成時は、分割取得されたデータを全てマージして利用します。
-
(例)2002020806
https://keiba.yahoo.co.jp/race/result/2005020806/
20 ⇒ 西暦年 YY
05 ⇒ 競馬場コード (東京)
02 ⇒ 開催回 (02回)
08 ⇒ 開催日目(08日目)
06 ⇒ レース番号 (06R)
●パラメータ
yy : 開催年
xx : 競馬場コード
yy : 開催回[第N回]
zz : 開催日目[N日目]
rr : レース番号
●競馬場コード
01 : 札幌競馬場
02 : 函館競馬場
03 : 福島競馬場
04 : 新潟競馬場
05 : 東京競馬場
06 : 中山競馬場
07 : 中京競馬場
08 : 京都競馬場
09 : 阪神競馬場
10 : 小倉競馬場
'**** 処理開始 ****
Private Sub IENavi_Click()
Call GetOpenFilename
End Sub
'***** 成績表データ消去 *****
Private Sub NaviDel_Click()
If Sheets("成績表").Range("B6") <> "" Then
Range("B6:U6000").SpecialCells(xlConstants, 23).ClearContents
End If
End Sub
標準モジュール(Seiseki)に、リンクリストを元に順次サイトを巡回させて、
成績表データを取得してシート上に書き出します。ソースコードは冗長ですが、天気や馬場状態が画像ファイルで表示させているため、
テキストデータとして取得するので、画像ファイルのクラス名より翻訳処理をしています。
レース結果の払い戻し番号取得する部分では、複勝の位置が変動するので、枠番の位置から馬番を求めるように処理しています。
頭数がデータとして取得できないので、競走成績一覧の表からカウントして頭数を算出しています。
取得が完了したら、カレントディレクリに日付時刻形式のファイル名として、CSV形式で出力します。
'*********************************************************************************
'*
'* 競馬成績表データ一括取得処理
'*
'* - IEによるインターネットサイト自動巡回 (Yahooスポーツ : 競馬) -
'* https://keiba.yahoo.co.jp/race/result/
'*
'* ●成績表の日程ファイルから取得した過去の成績表リンクファイルを利用
'*
'*
'*********************************************************************************
'* ☆Yahoo!スポーツ競馬 URL コード体系
'*********************************************************************************
'*
'* ●出走表の場合
'* https://keiba.yahoo.co.jp/race/denma/1205020806/
'*
'* ●成績表の場合
'* https://keiba.yahoo.co.jp/race/result/1205020806/
'*
'* ●開催日程の場合
'* https://keiba.yahoo.co.jp/schedule/list/2012/?month=1
'*
'* (例)
'* 12 ⇒ 西暦年 YY
'* 05 ⇒ 競馬場コード (東京)
'* 02 ⇒ 開催回 (02回)
'* 08 ⇒ 開催日目(08日目)
'* 06 ⇒ レース番号 (06R)
'*
'* ●パラメータ
'* yy : 開催年
'* xx : 競馬場コード
'* yy : 開催回[第N回]
'* zz : 開催日目[N日目]
'* rr : レース番号
'*
'* ●競馬場コード
'* 01 : 札幌競馬場
'* 02 : 函館競馬場
'* 03 : 福島競馬場
'* 04 : 新潟競馬場
'* 05 : 東京競馬場
'* 06 : 中山競馬場
'* 07 : 中京競馬場
'* 08 : 京都競馬場
'* 09 : 阪神競馬場
'* 10 : 小倉競馬場
'*
'* ●過去データ(成績表)の場合
'* 2000年1月29日（土） 10:00 1回東京1日
'* https://keiba.yahoo.co.jp/race/result/0005010101/
'*
'*********************************************************************************
'32bit版Excelの場合は、ptrsafe部分を削除して下さい。
' sleep関数(API)の宣言
Public Declare ptrsafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
' ShowWindow(API)の宣言
Public Declare ptrsafe Function ShowWindow Lib "user32" (ByVal hwindow As Long, ByVal cmdshow As Long) As Long
Dim objIE As Object
Dim obj As Object
'***** 自動巡回リストファイル選択ダイアログ *****
Public Sub GetOpenFilename()
Dim FileName As Variant
Dim PathName As String
Worksheets("成績表").Activate
Sheets("成績表").Select
Application.DefaultFilePath = ThisWorkbook.Path
PathName = ThisWorkbook.Path & "¥result¥"
ChDir PathName
'ファイルを開くダイアログ
FileName = _
Application.GetOpenFilename( _
FileFilter:="テキストファイル(*.txt),*.txt" & _
",CSVファイル(*.csv),*.csv" _
, FilterIndex:=1 _
, Title:="ファイルの選択" _
, MultiSelect:=False _
)
If FileName <> False Then
If Sheets("成績表").Range("B6") <> "" Then
Range("B6:U6000").SpecialCells(xlConstants, 23).ClearContents
End If
Call IE_open(FileName)
End If
End Sub
'***** 競馬成績表(Yahooスポーツ : 競馬) サイト自動巡回処理 *****
Private Sub IE_open(ByVal FileName As String)
Dim URL As String
Dim Path As String
Dim i As Integer
Dim p As Integer
Dim strText As String
Dim strArray() As String
Dim houseStr As String
On Error Resume Next
Worksheets("成績表").Activate
Sheets("成績表").Select
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = False
'***** 初期起動ページ表示 *****
URL = "https://keiba.yahoo.co.jp/"
objIE.Navigate URL
Do While objIE.ReadyState <> 4
Do While objIE.Busy = True
DoEvents
Loop
Loop
'***** ウィンドウ制御 (Max : 3, Min : 2) *****
ret = ShowWindow(objIE.Hwnd, 2)
objIE.Visible = True
'***** ファイル名を保存 *****
If FileName = "" Then
MsgBox "リストファイルが選択されていません。"
objIE.Quit
Set objIE = Nothing
Exit Sub
End If
'***** 選択されたファイルの有無を確認 *****
'With CreateObject("Scripting.FileSystemObject")
' If FileExists(FileName) = False Then
' MsgBox "ファイルが存在しません。"
' objIE.Quit
' Set objIE = Nothing
' Exit Sub
'End With
'***** ファイル名を退避 *****
Path = FileName
'***** ファイルを開く *****
Open Path For Input As #1
'▼▼▼▼▼ ここから繰り返し処理の開始 ▼▼▼▼▼
p = 6 ' 行の開始位置
'Application.ScreenUpdating = False
Do Until EOF(1)
' ファイルを１行読み込み
Line Input #1, URL
If URL = "" Then Exit Do
If Mid(URL, 1, 5) <> "https" Then
MsgBox "リストファイルにURLが含まれていません。"
objIE.Quit
Set objIE = Nothing
Exit Sub
End If
' 空行がある場合は処理を終了
If URL = "" Then Exit Do
' ナビゲート開始
objIE.Navigate URL
' ページが完全に表示されるまで待つ
Do While objIE.ReadyState <> 4
Do While objIE.Busy = True
DoEvents
Loop
Loop
'Sleep (100)
Application.StatusBar = objIE.Document.Title
'▼▼▼▼ データ取得処理 ▼▼▼▼
'***** レースコード *****
Cells(p, 3) = Replace(Right(URL, 11), "/", "")
'***** レース番号を取得 (1R etc) *****
For Each obj In objIE.Document.getElementsByTagName("td")
If obj.ID = "raceNo" Then
strText = obj.innerText
Cells(p, 4) = strText
Exit For
End If
Next
'***** 開催日、開催場所、発走時間を取得 *****
For Each obj In objIE.Document.getElementsByTagName("p")
If obj.ID = "raceTitDay" Then
houseStr = obj.innerText
' 取得内容を分解
strArray = Split(houseStr, "|")
'● 開催日を編集 (yyyy/mm/dd 形式)
strText = strArray(0)
strText = Mid(strText, 1, InStr(strText, "（") - 1)
strText = Replace(strText, "年", "/")
strText = Replace(strText, "月", "/")
strText = Replace(strText, "日", "")
Cells(p, 2) = strText
'● 開催場所を編集 (XX回中山XX日)
strText = Trim(strArray(1))
Cells(p, 6) = strText
'● 競馬場
strText = Mid(strText, InStr(strText, "回") + 1, 2)
Cells(p, 5) = strText
'● 発走時間
strText = Trim(strArray(2))
strText = Mid(strText, 1, InStr(strText, "発") - 1)
Cells(p, 7) = strText
Exit For
End If
Next
'***** 天気 (画像ファイルのクラス名より判定) *****
For Each obj In objIE.Document.getElementsByTagName("img")
Select Case obj.className
Case "spBg hare"
Cells(p, 8) = "晴"
Exit For
Case "spBg kumori"
Cells(p, 8) = "曇"
Exit For
Case "spBg ame"
Cells(p, 8) = "雨"
Exit For
Case "spBg yuki"
Cells(p, 8) = "雪"
Exit For
Case "spBg koyuki"
Cells(p, 8) = "小雪"
Exit For
Case "spBg kosame"
Cells(p, 8) = "小雨"
Exit For
End Select
Next
'***** 馬場 (画像ファイルのクラス名より判定) *****
For Each obj In objIE.Document.getElementsByTagName("img")
Select Case obj.className
Case "spBg ryou"
Cells(p, 9) = "良"
Exit For
Case "spBg yayaomo"
Cells(p, 9) = "稍重"
Exit For
Case "spBg omo"
Cells(p, 9) = "重"
Exit For
Case "spBg furyou"
Cells(p, 9) = "不良"
Exit For
End Select
Next
'***** レース名 *****
For Each obj In objIE.Document.getElementsByTagName("h1")
If obj.className = "fntB" Then
strText = obj.innerText
Cells(p, 10) = strText
Exit For
End If
Next
'***** コース、距離を取得 *****
For Each obj In objIE.Document.getElementsByTagName("p")
If obj.ID = "raceTitMeta" Then
houseStr = obj.innerText
' 取得内容を分解
strArray = Split(houseStr, "|")
strText = Trim(strArray(0))
'● コース (芝、ダート)
strText = Mid(strText, 1, InStr(strText, " ") - 1)
Cells(p, 11) = strText
'● 距離
strText = Trim(strArray(0))
strText = Mid(strText, InStr(strText, " ") + 1, 4)
Cells(p, 12) = strText
Exit For
End If
Next
'***** レース結果の払い戻し番号取得 - 1 *****
' ▼複勝の位置が変動するので、枠番の位置から馬番を求める
i = 0
j = 0
For Each obj In objIE.Document.all
Select Case obj.tagName
Case "TR", "TD", "TH"
If obj.offsetparent.className = "resultYen" Then
Select Case obj.tagName
Case "TR"
Case "TD", "TH"
'***** 単勝,枠連,馬連 *****
If obj.className = "txC resultNo" Then
i = i + 1
'● 単勝
If i = 1 Then
Cells(p, 13) = obj.innerText
End If
'● 枠連
If i > 2 And j = 0 And InStr(obj.innerText, "－") <> 0 Then
Cells(p, 14) = Replace(obj.innerText, "－", "-")
j = i
j = j + 1
End If
'● 馬連
If i = j And InStr(obj.innerText, "－") <> 0 Then
Cells(p, 15) = Replace(obj.innerText, "－", "-")
Exit For
End If
End If
End Select
End If
End Select
Next
'***** レース結果の払い戻し番号取得 - 2 *****
i = 0
For Each obj In objIE.Document.all
Select Case obj.tagName
Case "TR", "TD", "TH"
If obj.offsetparent.className = "resultYen noMgn" Then
Select Case obj.tagName
Case "TR"
Case "TD", "TH"
'***** 馬単,3連単 *****
If obj.className = "txC resultNo" Then
i = i + 1
'● 馬単
If i = 4 Then
houseStr = obj.innerText
If houseStr <> "" Then
Cells(p, 16) = Replace(houseStr, "－", "-")
End If
End If
'● 3連単
If i = 6 Then
houseStr = obj.innerText
If houseStr <> "" Then
Cells(p, 17) = Replace(houseStr, "－", "-")
'***********************************************************
' 3連単の結果から、1着,2着,3着の馬番を取得
' 過去のレースではデータなしのため、別途取得とする
' 2004年 9月11日の開催レースから
' 第４回中山競馬・第４回阪神競馬・第２回札幌競馬初日
'***********************************************************
'***** 取得内容を分解 *****
strArray = Split(Cells(p, 17).Value, "-")
Cells(p, 18) = Cells(p, 13).Value '●1着馬番号
Cells(p, 19) = strArray(1) '●2着馬番号
Cells(p, 20) = strArray(2) '●3着馬番号
End If
Exit For
End If
End If
End Select
End If
End Select
Next
'***** 頭数をカウントして求める *****
i = 0 ' ※ 頭数をカウントして算出
For Each obj In objIE.Document.all
Select Case obj.tagName
Case "TR", "TD", "TH"
If obj.offsetparent.className = "dataLs mgnBS" Then
Select Case obj.tagName
Case "TR"
' 空ループ
i = i + 1
Case "TD", "TH"
End Select
End If
End Select
Next
'● 頭数
Cells(p, 21) = i - 1
'***** 行をインクリメント *****
p = p + 1
Loop
'***** ファイルを閉じる *****
Close #1
objIE.Quit
Set objIE = Nothing
Set obj = Nothing
'▼▼▼▼ ファイル名を作成 ファイル名は自分のパス+¥SyyyymmddHHMMSS.csvとして自動生成 ▼▼▼▼
Dim FNAME As String
'***** ファイル名を合成 (年月日時分秒) *****
FNAME = "S" & Year(Date) & Right("0" & Month(Date), 2) & Right("0" & Day(Date), 2) & _
Right("0" & Hour(Time), 2) & Right("0" & Minute(Time), 2) & Right("0" & Second(Time), 2) & ".csv"
Dim strFNAME As String ' ファイル名保存用
strFNAME = ThisWorkbook.Path & "¥" & FNAME
'***** テーブルデータからCSV形式ファイルを出力する *****
Call MAKE_CSV_FILE(strFNAME, Range(Cells(6, 2), Cells(p - 1, 21)))
Application.ScreenUpdating = True
Application.StatusBar = False
Sheets("成績表").IENavi.Enabled = True
Sheets("成績表").NaviDel.Enabled = True
MsgBox "データ取得処理が完了しました"
Range("B6").Select
End Sub
'***** ファイルを開きカンマ区切りのファイルを作成する *****
Sub MAKE_CSV_FILE(strFNAME As String, objHANI As Range)
'***** ファイルをオープンする *****
Dim FNO As Integer ' ファイル番号
FNO = FreeFile ' 空いてるファイル番号を取出す
Open strFNAME For Output As #FNO ' テキストファイルを新規作成
'***** 行、列でループを作る *****
Dim Y As Integer
Dim x As Integer
For Y = 1 To objHANI.Rows.Count ' 行のループ
Print #FNO, Trim(objHANI.Cells(Y, 1).Value); ' 先頭項目の出力
For x = 2 To objHANI.Columns.Count ' 列のループ
Print #FNO, Trim(",");
Print #FNO, Trim(objHANI.Cells(Y, x).Value);
Next x
Print #FNO, Trim("") ' 改行のみ出力
Next Y
'***** ファイルクローズ *****
Close #FNO
End Sub
4.ダウンロード
提供するソースコードのライセンスは、CC0 (クレジット表示不要、改変可、商用可) とします。自由に利用して頂いてかまいません。
今回の記事で紹介してるプログラムは、本シリーズの連載最後にまとめてダウンロード提供する予定としています。 少しずつ記事をアップしていきますので、しばらくお付き合いください。
■関連記事
・Excelでデータベース(SQLite3)を扱う
・複数のファイルをマージする
・競馬成績表データベースを作る(事前準備編)
・競馬成績表データベースを作る(データベース編)
・競馬成績表データベースを作る(ツール－Excel編)
・競馬成績表データベースを作る(ツール－HSP編)
コメント
コメントを投稿