競馬成績表データベースを作る(ツール－Excel編)
1.概要
競馬成績表データベースを作るの第四弾です。これまで、作成したデータベースを活用するためには、検索表示などができないと
何の役にも立ちません。今回は、Excel VBAで作成します。当ブログ記事の「Excelでデータベース(SQLite3)を扱う」
で紹介しているテンプレートとなるソースコードを元にして、検索部分とデータ出力機能を追加しデータが抽出できるようにしたものです。
データベースをしっかり作成していれば、競馬以外の他の用途でも、いろいろと応用の効くものとすることができます。
2.ソースコード まずは、簡単に操作方法を説明します。Yahoo競馬レース成績表検索.xlsmを起動します。 検索条件のコンボボックスで「競馬場」、「距離」、「コース」の3つの条件を選択して、実行ボタンをクリックします。 抽出対象データがあれば、100件/1ページ単位にデータが表示されます。ページ制御をしていますので、「次ページ」、 「前ページ」、「先頭」、「最終」のボタンをクリックしてページを表示させます。 また、「出力」ボタンをクリックすると、CSV形式で抽出したデータを外部出力できます。「消去」ボタンは、 画面上のデータを強制的に消去するものです。新たな条件で「実行」ボタンをクリックすれば、前処理として 消去(画面クリア)させていますので、通常は操作不要です。尚、Yahoo競馬レース成績表検索.xlsmの実行には、 SQLiteのODBCとこのプログラムで利用するデータベース(pegasus.db)が必要ですので事前に準備しておいて下さい。
ThisWorkbookは、ブックを開いた時の初期設定処理をしています。検索条件設定用のコンボボックスに値をセットします。
参考として、データをExcelに取り込む場合は、メニューのデータから、リボンのデータの取得もしくは、テキストまたはCSVから実施して下さい。 Excelのバージョンによってリボンの名称や配置などが異なるかと思いますが、同じような機能があると思います。 筆者は、Windows10のMicrosoft365版のExcelを利用していますが、データの取り込みが従来のインポートがなくなっていて、Power Queryに なって少し操作に戸惑いました。標準では、従来のウィザードは利用できないと思っていましたが、ファイル→オプション→データ項目に レガシーデータインポートウィザードという項目があり、テキストから(レガシー)にチェックを入れると従来方式のウィザードが利用できました。
下記のいずれかの方法でCSVデータのインポートをして下さい。(参考)
下記のファイルをアーカイブにして提供します。データは、著作権に触れる恐れがあるため、配布することができません。 動作確認のテスト用のサンプルとして100件のみ入れてあります。実際に利用する場合は、各自で取得して新規に作成願います。 尚、データの取得やプログラム実行において損害等が生じた場合は、筆者は一切の責任も負いません。全て自己責任でお願いします。
ダウンロード
■関連記事
・Excelでデータベース(SQLite3)を扱う
・複数のファイルをマージする
・競馬成績表データベースを作る(事前準備編)
・競馬成績表データベースを作る(データ取得編)
・競馬成績表データベースを作る(データベース編)
・競馬成績表データベースを作る(ツール－HSP編)
2.ソースコード まずは、簡単に操作方法を説明します。Yahoo競馬レース成績表検索.xlsmを起動します。 検索条件のコンボボックスで「競馬場」、「距離」、「コース」の3つの条件を選択して、実行ボタンをクリックします。 抽出対象データがあれば、100件/1ページ単位にデータが表示されます。ページ制御をしていますので、「次ページ」、 「前ページ」、「先頭」、「最終」のボタンをクリックしてページを表示させます。 また、「出力」ボタンをクリックすると、CSV形式で抽出したデータを外部出力できます。「消去」ボタンは、 画面上のデータを強制的に消去するものです。新たな条件で「実行」ボタンをクリックすれば、前処理として 消去(画面クリア)させていますので、通常は操作不要です。尚、Yahoo競馬レース成績表検索.xlsmの実行には、 SQLiteのODBCとこのプログラムで利用するデータベース(pegasus.db)が必要ですので事前に準備しておいて下さい。
'***** ブックを開いた時の初期設定処理 *****
Private Sub Workbook_Open()
Sheets("成績表").Select
Worksheets("成績表").Activate
'***** 検索条件用のコンボボックスを設定 *****
' 競馬場
Dim CBRaceKaisai(10)
CBRaceKaisai(0) = "東京"
CBRaceKaisai(1) = "中山"
CBRaceKaisai(2) = "京都"
CBRaceKaisai(3) = "阪神"
CBRaceKaisai(4) = "中京"
CBRaceKaisai(5) = "札幌"
CBRaceKaisai(6) = "函館"
CBRaceKaisai(7) = "福島"
CBRaceKaisai(8) = "新潟"
CBRaceKaisai(9) = "小倉"
' 距離
Dim CBKyori(20)
CBKyori(0) = "1000"
CBKyori(1) = "1150"
CBKyori(2) = "1200"
CBKyori(3) = "1300"
CBKyori(4) = "1400"
CBKyori(5) = "1500"
CBKyori(6) = "1600"
CBKyori(7) = "1700"
CBKyori(8) = "1800"
CBKyori(9) = "2000"
CBKyori(10) = "2100"
CBKyori(11) = "2200"
CBKyori(12) = "2300"
CBKyori(13) = "2400"
CBKyori(14) = "2500"
CBKyori(15) = "2600"
CBKyori(16) = "3000"
CBKyori(17) = "3200"
CBKyori(18) = "3400"
CBKyori(19) = "3600"
' コース
Dim CBCource(3)
CBCource(0) = "ダート"
CBCource(1) = "芝"
CBCource(2) = "障害"
' 各コンボボックスに設定値をセット
Worksheets("成績表").KaisaiComb.List = CBRaceKaisai
Worksheets("成績表").KyoriComb.List = CBKyori
Worksheets("成績表").CourceComb.List = CBCource
End Sub
Sheet1(成績表)は、シート上に配置した各ボタンのクリックイベントに対応した
ルーチンへジャンプするための処理を記述しています。
'***** データ削除 ***** Private Sub DataClr_Click() Call DataDelete End Sub '***** ファイル出力 ***** Private Sub FileOut_Click() Call CSVout End Sub '***** 実行開始 ***** Private Sub StartDB_Click() Call DataBase_Init Call SQLite(0) End Sub '***** 前ページ表示制御 ***** Private Sub BeforePage_Click() Call SQLite(0) End Sub '***** 次ページ表示制御 ***** Private Sub NextPage_Click() Call SQLite(1) End Sub '***** 先頭ページ表示制御 ***** Private Sub FirstPage_Click() Call StartDB_Click End Sub '***** 最終ページ表示制御 ***** Private Sub LastPage_Click() Call SQLite(3) End Sub '***** 各変数の初期化 ***** Private Sub DataBase_Init() StartPoint = 0 PageNo = 0 PageCount = 0 BackPoint = 0 ReadRec = 0 DispRec = 0 N_Page = 0 N_Num = 0 B_Page = 0 B_Num = 0 LastPage = 0 StartFLG = 0 KeepPage = 0 End Sub標準モジュール : seisekiはメインとなる処理を記述しています。 ソースコードは「Excelでデータベース(SQLite3)を扱う」 で紹介しているものがベースとなっています。処理の大部分は、ページ制御部分であり、実際にデータベースからのデータ抽出と表示部分は データベースの項目数(フィールド)の数だけ設定してループを回しているだけです。 処理の流れは、データベースオープン→テーブルセット→SQL文(クエリ)発行→ループでデータ表示といった流れになっています。 ルーチンの重複がありますが、外部データへの出力も同じで、抽出したデータをカンマ区切りとしてテキスト形式(CSV)で書き出しています。 尚、参考補足事項ですが、出力されたCSVファイルをダブルクリックしてExcelとの関連付け起動させないでください。Excelのセルの書式(属性) に自動で調整されて、日付形式などの意図しない形式で表示されてしまいます。データの確認は、メモ帳などのテキストエディタで確認して下さい。
参考として、データをExcelに取り込む場合は、メニューのデータから、リボンのデータの取得もしくは、テキストまたはCSVから実施して下さい。 Excelのバージョンによってリボンの名称や配置などが異なるかと思いますが、同じような機能があると思います。 筆者は、Windows10のMicrosoft365版のExcelを利用していますが、データの取り込みが従来のインポートがなくなっていて、Power Queryに なって少し操作に戸惑いました。標準では、従来のウィザードは利用できないと思っていましたが、ファイル→オプション→データ項目に レガシーデータインポートウィザードという項目があり、テキストから(レガシー)にチェックを入れると従来方式のウィザードが利用できました。
'*********************************************************************************
'*
'* レース成績表データベース検索処理
'*
'*
'* ●Pegasus.db（SQLite3）利用によるレース成績表データベース検索
'*
'*
'*********************************************************************************
'***** グローバル変数 *****
Public My_Row As Long ' 行位置
Public My_Col As Long ' 列位置
Public StarPoint As Integer ' レコード開始位置
Public PageNo As Integer ' ページ番号
Public PageCount As Integer ' ページカウンタ
Public BackPoint As Integer ' 前ページ開始位置
Public B_Page As Integer ' 前ページ開始位置一時保存
Public B_Num As Integer ' 前ページ番号一時保存
Public N_Page As Integer ' 次ページ開始位置一時保存
Public N_Num As Integer ' 次ページ番号一時保存
Public StartFLG As Integer ' 前ページ、次ページ判定フラグ
Public KeepPage As Integer ' 最終ページ番号保存用
Public filename As String ' DataBase FileName
Public i As Long ' セルの表示開始位置制御カウンタ
Public DBName As String ' DataBace ODBC定義 (SQLite3)
Public Sql As String ' SQL
Public Db As Object ' DataBase
Public rs As Object ' Recordset
'***** データベース処理開始 (全件表示 : 100件単位) *****
Public Sub SQLite(ByVal StartFLG As Integer)
Dim S_PageCnt As Integer ' 開始ページカウンタ保存用
Dim S_PageNum As Integer ' 開始ページ番号保存用
Dim ReadRec As Integer ' 読み出しレコードカウンタ
Dim DispRec As Integer ' 表示件数制御カウンタ
Dim LastPage As Integer ' 最終ページ番号取得用
On Error Resume Next
'***** 前ページをセット *****
If StartFLG = 0 Then
S_PageCnt = B_Page
S_PageNum = B_Num
End If
'***** 次ページをセット *****
If StartFLG = 1 Then
S_PageCnt = N_Page
S_PageNum = N_Num
End If
'***** 最終ページをセット *****
If StartFLG = 3 Then
S_PageCnt = (KeepPage * PageCount) - PageCount + 1
S_PageNum = KeepPage
End If
'***** 画面クリア *****
Call DataDelete
'***** DB FileName設定 (※変更のこと) *****
If Dir(ThisWorkbook.Path & "¥pegasus.db") = "" Then
MsgBox "データベースファイルが存在しません。"
Exit Sub
End If
'***** データベースオープン *****
Call SQLiteDB_Open("pegasus.db")
'***** コンボボックスの各設定値をセット *****
Kaisai = Worksheets("成績表").KaisaiComb.Text
cource = Worksheets("成績表").CourceComb.Text
sKyori = Worksheets("成績表").KyoriComb.Text
'***** SQL文を発行 *****
Sql = "SELECT * FROM seisekidb WHERE KeiBabajyou COLLATE NOCASE LIKE '%" & Kaisai & "%'" _
& " AND Cource COLLATE NOCASE LIKE " & "'" & cource & "%'" _
& " AND Kyori COLLATE NOCASE LIKE " & "'%" & sKyori & "%'" _
& " ORDER BY ID ASC LIMIT 5000"
'***** テーブルセット *****
Call Table_Set
'***** 抽出レコード件数 *****
RecCount = rs.RecordCount
Range("B4") = RecCount
If RecCount = 0 Then
Call DB_Close
MsgBox "対象データがありませんでした。"
Exit Sub
End If
'***** 画面の表示更新停止開始 *****
Application.ScreenUpdating = False
'***** ページ制御カウンタ *****
StartPoint = S_PageCnt
PageNo = S_PageNum
PageCount = 100
BackPoint = StartPoint - PageCount
ReadRec = 0
DispRec = 0
'***** 初期値確認 (StartPoint) *****
If StartPoint = 0 Then
StartPoint = 1
PageNo = 1
Worksheets("成績表").BeforePage.Enabled = False
Worksheets("成績表").FirstPage.Enabled = False
End If
'***** 初期値確認 (PageNo) *****
If PageNo = 0 Then
PageNo = 1
Worksheets("成績表").BeforePage.Enabled = False
Worksheets("成績表").FirstPage.Enabled = False
End If
'***** ページ番号を表示 *****
Range("A4") = PageNo
'***** 最終ページ番号 *****
LastPage = (RecCount / PageCount) + 1
'***** 最終ページ保存 *****
If RecCount <= 100 Then LastPage = LastPage - 1
KeepPage = LastPage
Range("C4") = PageNo & " / " & KeepPage
If rs.EOF Then
StartPoint = 0
PageNo = 0
PageCount = 0
BackPoint = 0
ReadRec = 0
DispRec = 0
StartFLG = 0
'***** 全制御ボタンを不活性化 *****
Worksheets("成績表").BeforePage.Enabled = False
Worksheets("成績表").NextPage.Enabled = False
Worksheets("成績表").FirstPage.Enabled = False
Worksheets("成績表").LastPage.Enabled = False
Else
'▼▼▼▼ 結果をセルに書き込む (表示) ▼▼▼▼
i = 6 ' 表示開始位置 : 6行目～105行目
Do Until rs.EOF = True
' 読み込みレコードカウンタ
ReadRec = ReadRec + 1
' データ開始レコードまで読み飛ばし
If StartPoint <= ReadRec Then
' 設定(100件/頁)になったら表示を終了
If DispRec = PageCount Then
Worksheets("成績表").NextPage.Enabled = False
Exit Do
End If
' 表示レコードカウンタ
DispRec = DispRec + 1
'============= 結果の表示 ==========================================
Cells(i, 1).Value = ReadRec ' No. (ReadRec)
Cells(i, 2).Value = rs.Fields(1).Value ' 日付 (RaceDate)
Cells(i, 3).Value = rs.Fields(2).Value ' コード (BabaCode)
Cells(i, 4).Value = rs.Fields(3).Value ' R番号 (RaceNo)
Cells(i, 5).Value = rs.Fields(4).Value ' 競馬場 (KeiBabajyou)
Cells(i, 6).Value = rs.Fields(5).Value ' 開催 (Kaisai)
Cells(i, 7).Value = rs.Fields(6).Value ' 発走時間 (StartTime)
Cells(i, 8).Value = rs.Fields(7).Value ' 天気 (Tenki)
Cells(i, 9).Value = rs.Fields(8).Value ' 馬場 (Baba)
Cells(i, 10).Value = rs.Fields(9).Value ' レース名 (RaceName)
Cells(i, 11).Value = rs.Fields(10).Value ' コース (Cource)
Cells(i, 12).Value = rs.Fields(11).Value ' 距離 (Kyori)
Cells(i, 13).Value = rs.Fields(12).Value ' 単勝 (TanSyou)
Cells(i, 14).Value = rs.Fields(13).Value ' 枠連 (Wakulen)
Cells(i, 15).Value = rs.Fields(14).Value ' 馬連 (Umalen)
Cells(i, 16).Value = rs.Fields(15).Value ' 馬単 (UmaTan)
Cells(i, 17).Value = rs.Fields(16).Value ' 3連単 (SanlenTan)
Cells(i, 18).Value = rs.Fields(17).Value ' 1着 (OneUma)
Cells(i, 19).Value = rs.Fields(18).Value ' 2着 (TwoUma)
Cells(i, 20).Value = rs.Fields(19).Value ' 3着 (ThreeUma)
Cells(i, 21).Value = rs.Fields(20).Value ' 頭数 (Tousu)
' カウントアップ
i = i + 1
End If
rs.MoveNext
Loop
'***** 画面の表示更新停止解除 *****
Application.ScreenUpdating = True
'***** レコードの開始位置 *****
StartPoint = PageCount * PageNo + 1
'***** ページ制御 *****
'***** 前ページの場合 *****
If PageNo > 1 Then
Worksheets("成績表").BeforePage.Enabled = True
Worksheets("成績表").FirstPage.Enabled = True
StartFLG = 0
B_Page = BackPoint
B_Num = PageNo - 1
End If
'***** 次ページの場合 *****
If PageNo < LastPage Then
Worksheets("成績表").NextPage.Enabled = True
Worksheets("成績表").LastPage.Enabled = True
StartFLG = 1
N_Page = StartPoint
N_Num = PageNo + 1
End If
End If
'***** 前ページボタン不活性化 *****
If PageNo = 1 Then
Worksheets("成績表").BeforePage.Enabled = False
Worksheets("成績表").FirstPage.Enabled = False
End If
'***** 次ページボタン不活性化 *****
If PageNo >= LastPage Then
Worksheets("成績表").NextPage.Enabled = False
Worksheets("成績表").LastPage.Enabled = False
End If
'***** 画面更新の実行 *****
Application.ScreenUpdating = True
Range("B4").Select
'***** 接続を閉じる *****
Call DB_Close
Range("A1").Select
End Sub
'***** 抽出ファイル出力 *****
Sub CSVout()
Dim buf, StrTemp As String
Dim FNAME As String
'***** DB FileName設定 (※変更のこと) *****
If Dir(ThisWorkbook.Path & "¥pegasus.db") = "" Then
MsgBox "データベースファイルが存在しません。"
Exit Sub
End If
'***** データベースオープン *****
Call SQLiteDB_Open("pegasus.db")
'***** コンボボックスの各設定値をセット *****
Kaisai = Worksheets("成績表").KaisaiComb.Text
cource = Worksheets("成績表").CourceComb.Text
sKyori = Worksheets("成績表").KyoriComb.Text
'***** SQL文を発行 *****
Sql = "SELECT * FROM seisekidb WHERE KeiBabajyou COLLATE NOCASE LIKE '%" & Kaisai & "%'" _
& " AND Cource COLLATE NOCASE LIKE " & "'" & cource & "%'" _
& " AND Kyori COLLATE NOCASE LIKE " & "'%" & sKyori & "%'" _
& " ORDER BY ID ASC LIMIT 5000"
'***** テーブルセット *****
Call Table_Set
'***** 抽出レコード件数 *****
RecCount = rs.RecordCount
Range("B4") = RecCount
If RecCount = 0 Then
Call DB_Close
MsgBox "対象データがありませんでした。"
Exit Sub
End If
Do Until rs.EOF = True
'***** バッファにカンマ区切りのデータをセット *****
StrTemp = rs.Fields(1).Value & "," & _
rs.Fields(2).Value & "," & _
rs.Fields(3).Value & "," & _
rs.Fields(4).Value & "," & _
rs.Fields(5).Value & "," & _
rs.Fields(6).Value & "," & _
rs.Fields(7).Value & "," & _
rs.Fields(8).Value & "," & _
rs.Fields(9).Value & "," & _
rs.Fields(10).Value & "," & _
rs.Fields(11).Value & "," & _
rs.Fields(12).Value & "," & _
rs.Fields(13).Value & "," & _
rs.Fields(14).Value & "," & _
rs.Fields(15).Value & "," & _
rs.Fields(16).Value & "," & _
rs.Fields(17).Value & "," & _
rs.Fields(18).Value & "," & _
rs.Fields(19).Value & "," & _
rs.Fields(20).Value & vbCrLf
' レコードを加算
buf = buf + StrTemp
rs.MoveNext
Loop
'***** 抽出対象ファイルが無い場合 *****
If buf = "" Then
MsgBox "抽出対象ファイルがありません。"
Call DB_Close
Exit Sub
End If
'***** ファイル名を合成 (年月日時分秒) *****
FNAME = "Seiseki_" & 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"
Open ThisWorkbook.Path & "¥" & FNAME For Output As #1
Print #1, buf
Close #1
MsgBox "ファイルに " & RecCount & "件 出力しました。"
'***** 接続を閉じる *****
Call DB_Close
End Sub
'***** データベースオープン *****
Sub SQLiteDB_Open(ByVal DBSetName As String)
filename = ThisWorkbook.Path & "¥pegasus.db"
DBName = "DRIVER=SQLite3 ODBC Driver;Database=" & filename & ";"
Set Db = CreateObject("ADODB.Connection")
Db.CursorLocation = 3
Db.Open DBName
End Sub
'***** テーブルセット *****
Sub Table_Set()
Set rs = CreateObject("ADODB.Recordset")
rs.Open Sql, Db, 3, 3
Set rs = Db.Execute(Sql)
End Sub
'***** データベースクローズ *****
Sub DB_Close()
rs.Close
Db.Close
Set rs = Nothing
Set Db = Nothing
End Sub
'***** データ消去 *****
Sub DataDelete()
Sheets("成績表").Select
Worksheets("成績表").Activate
If Range("A6") <> "" Then
Application.ScreenUpdating = False
Range("A6:U113").SpecialCells(xlCellTypeConstants, 23).ClearContents
Range("A4:C4").Value = ""
Application.ScreenUpdating = True
End If
End Sub
3.ダウンロード
提供するソースコードのライセンスは、CC0 (クレジット表示不要、改変可、商用可) とします。自由に利用して頂いてかまいません。
下記のファイルをアーカイブにして提供します。データは、著作権に触れる恐れがあるため、配布することができません。 動作確認のテスト用のサンプルとして100件のみ入れてあります。実際に利用する場合は、各自で取得して新規に作成願います。 尚、データの取得やプログラム実行において損害等が生じた場合は、筆者は一切の責任も負いません。全て自己責任でお願いします。
-
・import.bat
・pegasus.db
・raceseiseki.exe
・raceseiseki.hsp
・sqlite3.dll (raceseiseki.exeを実行するのに必要)
・Yahoo競馬結果リンク先取得.xlsm
・Yahoo競馬レース結果取得.xlsm
・Yahoo競馬レース成績表検索.xlsm
・ヘッダー名.txt
ダウンロード
■関連記事
・Excelでデータベース(SQLite3)を扱う
・複数のファイルをマージする
・競馬成績表データベースを作る(事前準備編)
・競馬成績表データベースを作る(データ取得編)
・競馬成績表データベースを作る(データベース編)
・競馬成績表データベースを作る(ツール－HSP編)
コメント
コメントを投稿