競馬成績表データベースを作る(ツール－Excel編)

1.概要

競馬成績表データベースを作るの第四弾です。これまで、作成したデータベースを活用するためには、検索表示などができないと 何の役にも立ちません。今回は、Excel VBAで作成します。当ブログ記事の「Excelでデータベース(SQLite3)を扱う」 で紹介しているテンプレートとなるソースコードを元にして、検索部分とデータ出力機能を追加しデータが抽出できるようにしたものです。 データベースをしっかり作成していれば、競馬以外の他の用途でも、いろいろと応用の効くものとすることができます。

2.ソースコード

まずは、簡単に操作方法を説明します。Yahoo競馬レース成績表検索.xlsmを起動します。 検索条件のコンボボックスで「競馬場」、「距離」、「コース」の3つの条件を選択して、実行ボタンをクリックします。 抽出対象データがあれば、100件/1ページ単位にデータが表示されます。ページ制御をしていますので、「次ページ」、 「前ページ」、「先頭」、「最終」のボタンをクリックしてページを表示させます。 また、「出力」ボタンをクリックすると、CSV形式で抽出したデータを外部出力できます。「消去」ボタンは、 画面上のデータを強制的に消去するものです。新たな条件で「実行」ボタンをクリックすれば、前処理として 消去(画面クリア)させていますので、通常は操作不要です。尚、Yahoo競馬レース成績表検索.xlsmの実行には、 SQLiteのODBCとこのプログラムで利用するデータベース(pegasus.db)が必要ですので事前に準備しておいて下さい。

ThisWorkbookは、ブックを開いた時の初期設定処理をしています。検索条件設定用のコンボボックスに値をセットします。

ThisWorkbook

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54

'***** ブックを開いた時の初期設定処理 ***** 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(成績表)は、シート上に配置した各ボタンのクリックイベントに対応した ルーチンへジャンプするための処理を記述しています。

Sheet1(成績表)

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

'***** データ削除 ***** 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に なって少し操作に戸惑いました。標準では、従来のウィザードは利用できないと思っていましたが、ファイル→オプション→データ項目に レガシーデータインポートウィザードという項目があり、テキストから(レガシー)にチェックを入れると従来方式のウィザードが利用できました。

下記のいずれかの方法でCSVデータのインポートをして下さい。(参考)

標準モジュール : seiseki

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347

'********************************************************************************* '* '*      レース成績表データベース検索処理 '* '* '*      ●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

「ツール－HSP編」で予定しているHSPのツールとソースも同梱しています。

ダウンロード

■関連記事
・Excelでデータベース(SQLite3)を扱う
・複数のファイルをマージする
・競馬成績表データベースを作る(事前準備編)
・競馬成績表データベースを作る(データ取得編)
・競馬成績表データベースを作る(データベース編)
・競馬成績表データベースを作る(ツール－HSP編)