第3回 出馬表とオッズの取得

ブック内のワークシート名の設定

JRAのホームページのオッズメニューから、出馬表（単勝/複勝オッズ）と3式別のオッズをコピーしてシートに貼り付けます。列幅は見やすいように調整してください。19年12月からオッズの貼り付け結果が以下のように行方向の縦長になってしまいました。まずはA図のセル位置に1レース分のオッズをペーストするマクロをつくります。
ファイル名は「出馬表作成」など適当な名前を付けて「Excelマクロ有効ブック」で保存しておきます。そうするとマクロが有効になり拡張子は「○○.xlsm」になります。このファイルをベースにマクロは展開していきます。

自作ソフトFactorXのブックで使っているそれぞれのシート名を参考までに載せておきます。これから出てくるすべてのマクロで使うワークシート名になりますので、自分で分かりやすいシート名をここで設定しておきます。変更するのが煩わしければそのまま使ったほうが、面倒がありません。
下図左から<Menu><Preview><InpOds><shCalc><Judge><Item>になっています。

シートの説明

1. Menu…発走前のオッズを取得して「FactorXで当日レース分析」「期待値の計算」「FactorXでの分析結果とレース成績作成」の3つを操作するボタンを配置。
2. Preview…FactorXの分析結果（これをみて購入馬券の判断）。
3. InpOds…A図のような出馬表とオッズを貼り付けるシート。
4. shCalc…取得したオッズをこのシート上で計算/分析。
5. Judge…分析結果を一時的に記録して、Previewに書き込むデータを選択。
6. Item…枠別の色、フォームの文字列などを書き入れている。

JRAのサイトからオッズをコピペするマクロ

JRAのサイトから希望の競馬場のレースを選択して出馬表（単勝/複勝）、枠複、馬複、馬単のオッズを順にコピーし、エクセルのワークシートにペーストするマクロです。下記のようなマクロでなく直接オッズをダウンロードしてワークシートに配置する方法がありますが、自分自身まだハードルが高かったのでコピーにしました。また、各オッズのコピー範囲についてはTips〈オッズのコピー方法とその範囲〉を参照ください。

流れが分かったところでマクロを書いてみましょう。

それでは[開発]タブのVisual Basicをクリックして [挿入]＞標準モジュールを追加して以下のマクロを書いてみましょう。マクロは「Sub 出馬表複写」で始まり「End Sub」で終わります。またマクロは下記の「かいせつ」で補足説明していますのでそちらも参考にしてください。

 Option Explicit
 
         Dim ws2 As Worksheet                                      '1（かいせつを参照　以下同）
         Dim ws3 As Worksheet
         Dim ws4 As Worksheet
         Dim shColm As Long
         
 '===================================
 ' 出馬表(単勝）⇒枠連⇒馬連⇒馬単の
 '　順にTABキーを押すことにより複写
 '===================================
 

     '（cntl+a）でマクロの実行
     Sub 出馬表複写()
          Dim tosu As Long
          Dim adr As String
         
                     Set ws3 = Worksheets("InpOds")              '2
                 
                adr = ActiveCell.Address                         　　'3
                 
             If adr <> Range("b7") Then
                 
                 ws3.Range("b7").Select                          　 '4
             
             End If
                 
                 'jraからコピーしたオッズをペースト              　'5
                     ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                         False, NoHTMLFormatting:=True
          
                             'c7の馬番が1でないならペーストミス   '6
                             If ws3.Range("c7") <> 1 Then
                             
                                 '再入力のためご入力範囲を消去
                                 ws3.Range("b7:k25").ClearContents
                                        
                                 '再入力 位置に移動
                                 ws3.Range("b7").Select
                 
                                         MsgBox "入力ミスです。先に出馬表を再コピーしてから,ボタンを押してください"
          
                                             ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                                             False, NoHTMLFormatting:=True
                             End If
                         
                                 'c列馬番の最大値から頭数を割り出す
                                     tosu = Application.WorksheetFunction. _
                                     Max(ws3.Range("c7:c24"))
             
                 '8頭立て以下では枠連の発売がないので"馬連"にジャンプ
             
                 If tosu >= 9 Then
             
                     ws3.Range("m7").Select
                     Application.OnKey "{tab}", "枠連"                   '7
             
                         Else
                             ws3.Range("o7").Select
                             Application.OnKey "{tab}", "馬連"           '8
             
                 End If
             
     End Sub 

次は枠複のオッズをペーストするマクロです。同じモジュール内に以下のマクロを書き加えてください。Tabキーを押すことによって枠複オッズをペースト後、馬複のオッズ複写位置にジャンプします。

    Sub 枠複()
         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
             False, NoHTMLFormatting:=True                           '1     

                 If ws3.Range("m8") <> 1 Then                            '2

                     '再入力のためご入力範囲を消去
                     ws3.Range("m7:n57").ClearContents

                         '再入力 位置に移動
                         ws3.Range("m7").Select

                                 MsgBox "入力ミスです。先に枠複オッズを再コピーしてから,ボタンを押してください"

                         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                             False, NoHTMLFormatting:=True
                 End If

             ws3.Range("o7").Select                                '3

             Application.OnKey "{tab}", "馬複"                   '4

     End Sub 

    Sub 馬複()

         ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
             False, NoHTMLFormatting:=True

                 If ws3.Range("o7") <> 1 Then

                     '再入力のためご入力範囲を消去
                     ws3.Range("o7:p191").ClearContents

                         '再入力 位置に移動
                         ws3.Range("o7").Select

                                     MsgBox "入力ミスです。先に馬複オッズを再コピーしてから,ボタンを押してください"

                                 ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                                     False, NoHTMLFormatting:=True
                 End If

             ws3.Range("q7").Select

             Application.OnKey "{tab}", "馬単"

     End Sub


     Sub 馬単()
             Dim inpRng As Range    ’22年8月12日追加および変更
                 ’If ws3.Range("q7") <> 1 Then      この行を下行に移動
                   ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                           False, NoHTMLFormatting:=True
                   '入力ミスの判定
                   If ws3.Range("q7") <> 1 Then      'この位置に移動
                             '再入力のためご入力範囲を消去
                           ws3.Range("q7:r364").ClearContents

                                 '再入力 位置に移動
                                 ws3.Range("q7").Select

                             MsgBox "入力ミスです。先に馬単オッズを再コピーして,ボタンを押してください"

                                 ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:= _
                                     False, NoHTMLFormatting:=True

                    End If

                 Application.OnKey "{tab}"         '1

                             'Topに移動                   '２
                             ws3.Range("b7").Select
                       '■■入力オッズのすべての「取消」セルを空欄に置き換える ’22年8月12日  以下2行を追加
                         Set inpRng =Range("b7:r364)
                              inpRng.Replace What:="取消", replacement:=""
     End Sub     

URLからコピーしたオッズは、普通にワークシートにペーストすると以下のようになってしまいます。このようなケースでは、「貼り付けのオプション」〈ホーム〜貼り付け〜貼り付け先の書式に合わせる〉でペーストするとA図のようにできます。しかし、貼り付ける時にいちいち「貼り付けオプション」を選択してペーストするのは面倒な作業です。このような作業はマクロの出番といえます。

オッズのコピペはできましたか。次はオッズを見やすく整理してみましょう。