第7回単勝人気順の組合せでオッズを表示

出馬表に取消馬がいた場合、エラー回避のため「競馬で学ぶエクセル」における下記の回を修正いたしました。ここ「第7回単勝人気順の組合せでオッズを表示」では修正後のマクロをもとに進めています。

第3回出馬表とオッズの取得
Sub 馬単（）・・・5ヶ所（22年8月12日修正）
第4回オッズを見やすく表に整形
Sub odds表作成（）・・・5ヶ所（21年11月3日修正）
第5回オリジナルの出馬表を作成
Sub 出馬表作成（）・・・2ヶ所（22年8月12日修正）
Sub 順位の取得（）・・・1ヶ所（22年8月12日修正）
第6回券種ごとの単勝人気順オッズテーブル作成
Sub人気順オッズテーブル（）・・・6ヶ所（22年8月13日修正）

以上の修正で出走取消馬にはデータが入力されていません。

単勝人気順の組合せで馬券別にオッズを表示する

Previewシートに単勝人気順の組合せを縦列と並列の二通りの表示方法で考えます。
オッズ分析などで2次利用したい時は縦列、分かりやすく見栄えを優先するなら並列表示を選択します。
ここでは標準モジュールを追加して新しくマクロを書く場所を確保しております。馬券別の縦列表示と並列表示のプロシージャは同じモジュール内に書いています。

Previewシートに組合せとオッズを縦列に表示

オッズの縦列表示例です。Previewシートに配置すると見づらいですが、この表示方法はオッズを単勝人気順の組合せで並べます。

自作ソフトFactorXでは下図のような「Judgeシート」に、単勝人気順にオッズを縦列配置してオッズ分析をしています。単純にこれを見るだけでも、どの馬から馬券が売れているか分かります。参考にした22年8月14日の4回小倉競馬2日目第12レースでは、9番プラチナドリーム（10番人気）が2着にきました。当該馬連の組合せ9-15とひとつ前の人気4-15のオッズを比較すると9-15が売れているのが分かります。同じように枠連は5枠絡みの馬券が売れています。これほど明快なケースは多くはないのでチェックをしつつ参考程度に考えています。

【枠連】単勝人気順の組合せ縦列表示のマクロをつくる

枠連を単勝人気順に表示するには「第6回券種ごとの・・・・・」で作ったオッズテーブルを使用します。マクロを説明するにあたりそこで制作したセル番地をベースにしています。

「第6回券種ごとの単勝人気順にオッズテーブル作成」で作成した枠連の人気順オッズテーブル

Option Explicit
  ’モジュールの先頭で宣言した変数は _
   宣言したモジュールで有効
    Dim ws2 As Worksheet
    Dim ws4 As Worksheet
    Dim ws5 As Worksheet

Sub 枠連人気順縦並べ()
    '------------------------------------
    '   単勝人気順の枠連組合せとオッズを
    '   Previewシートに書込む
    '------------------------------------
    Dim i As Integer, j As Integer
    Dim main As Range
    Dim subs As Range
    Dim Odds As Single
    Dim rowCnt As Long

        Set ws2 = Worksheets("preview")
        Set ws4 = Worksheets("Calc")
        Set ws5 = Worksheets("Item")

            '【方法1】枠連の見出しを作る                ’1
            ws2.Range("p6") = "枠 連"
            
                 With ws2.Range("p6")
                    .Font.Name = "游ゴシック"
                    .Font.Size = 9
                    .Font.Bold = True
                    .Font.ColorIndex = 2
                    .HorizontalAlignment = xlCenter
                    .Interior.ColorIndex = 48
                 End With

                    ws2.Range("p6:r6").Merge

            '【方法2】枠連の見出しを作る                 '2

            With ws2
                ws5.Range("見出し_枠連").Copy .Range("p6")
                .Range(.Cells(6, "p"), .Cells(6, "r")).Merge
            End With
            
                rowCnt = 7                            ’3
                 
        For i = 1 To 8                                   ’4
        
            For j = 1 To 9 - i                            '5

                    '軸番（main）
                        Set main = ws4.Cells(25, 20 + i)
                    '紐番（substitute）
                        Set subs = ws4.Cells(25 + i + j, "s")
                    '枠連オッズの取得（枠連テーブルより取得）
                        Odds = ws4.Cells(25 + i + j, 20 + i)
                            
                
                '人気順枠組合せの作成(4-3を3-4のように直す）
                If main < subs Then                   '6
                    
                    'オッズTable上部の枠色付き軸番をコピー
                        main.Copy
                        
                     'Previewシートの軸番にペースト
                         ws2.Cells(rowCnt, "p").PasteSpecial Paste:=xlPasteAll
                         
                             
                        'オッズTable左側の枠色付き紐番をコピー
                          subs.Copy
                                
                        'Previewシートの紐番にペースト
                           ws2.Cells(rowCnt, "q").PasteSpecial Paste:=xlPasteAll
                            
                            Else    'main>subsとmain=subs（ゾロ目）のケース   '7

                                'オッズTable上部の枠色付き軸番をコピー
                                    main.Copy
                                    
                                'Previewシートの紐番にペースト
                                    ws2.Cells(rowCnt, "q").PasteSpecial Paste:=xlPasteAll

                                'オッズTable左側の枠色付き紐番をコピー
                                    subs.Copy
                                    
                                'Previewシートの軸番にペースト
                                ws2.Cells(rowCnt, "p").PasteSpecial Paste:=xlPasteAll
                            
                End If
                        If Odds <> 0 Then
                            ws2.Cells(rowCnt, "r") = Odds                         '8

                                Else
                                    ws2.Cells(rowCnt, "r") = ""
  
                        End If

                                rowCnt = rowCnt + 1                                 '9
         
            Next j
  
            
        Next i

             'コピー状態の解除
                Application.CutCopyMode = False

End Sub
'Sub 馬連人気順縦並べ()をここから書き始める

かいせつ

【方法1】Previewシートのセル”p6″に配置した「枠連」の文字にたいしての書式設定
【方法2】Previewシートのセル”p6″に見出しを作る＜方法1＞では書式設定をしましたが＜方法2＞では簡単にコピペで作っています。そのためにはItemシートに「枠連」の見出しをあらかじめ作って名前の定義をしておきます
見出しの入力セルP6〜R6のセルを結合
馬連/馬単ではItemシートに作った見出しをコピペするので、事前に見出しを作っておいてください

次のプロシージャからは【方法2】で書いていきます

Previewシートにデータを書込む行位置の設定で7行目から書込む
「For i=1to8」枠連なので1番人気枠から8番人気枠まで実行
軸の1番人気枠は1〜8、2番人気枠は2〜8というように「jの値」は「iの値」が1増するごとに1減するので For j = 1 to 9 – i （終了数値の9から”i”の数だけ減らす）
軸枠番が紐枠番より小さければPreviewシートの[軸番][紐番]の順にコピペ
軸枠番が紐枠番より大きい時やゾロ目時の処理
Previewシートの枠連組合せ隣のセル、列Rにオッズを入力
rowCnt=rowCnt+1は、処理が1回終了ごとに1増し、行が下方向に1行づつ移動します

【馬連】Previewシートに組合せとオッズを縦列に表示

馬連を単勝人気順に表示するには「第6回券種ごとの・・・・・」で作ったオッズテーブルを使用します。マクロを説明するにあたりそこで制作したセル番地をベースにしています。

「第6回券種ごとの単勝人気順にオッズテーブル作成」で作成した馬連の人気順オッズテーブル

Sub 馬連人気順縦並べ()

    '------------------------------------
    '   単勝人気順の馬連組合せとオッズを
    '   Previewシートに書込む
    '------------------------------------
    
    Dim i As Integer, j As Integer
    Dim tosu As Long
    Dim main As Range
    Dim subs As Range
    Dim Odds As Single
    Dim rowCnt As Long
    
        Set ws2 = Worksheets("preview")
        Set ws4 = Worksheets("Calc")
        Set ws5 = Worksheets("Item")

            '馬連の見出しを作る                   ’1
            With ws2
                ws5.Range("見出し_馬連").Copy .Range("t6")
                .Range(.Cells(6, "t"), .Cells(6, "v")).Merge
            End With
    
                rowCnt = 7
                
                    'Calcシートのs列馬番の入力セル数から頭数を割り出す
                        tosu = Application.WorksheetFunction.CountA(ws4.Range("s44:s61"))
                
                 
        For i = 1 To tosu
        
            For j = 1 To tosu + 1 - i

                    '軸番（main）                                 '2
                        Set main = ws4.Cells(42, 20 + i)
                    '紐番（substitute）
                        Set subs = ws4.Cells(42 + i + j, "s")
                    '馬連オッズの取得（馬連テーブルより取得）
                        Odds = ws4.Cells(42 + i + j, 20 + i)
                
                '単勝人気順の馬組合せの作成(4-3を3-4のように直す）ゾロ目は書き込まない
                    
                If main < subs Then                        '3                        
                    
                    'オッズTable上部の枠色付き軸番をコピー
                        main.Copy
                        
                     'Previewシートの軸番にペースト
                         ws2.Cells(rowCnt, "t").PasteSpecial Paste:=xlPasteAll
                         
                             
                        'オッズTable左側の枠色付き紐番をコピー
                          subs.Copy
                                
                        'Previewシートの紐番にペースト
                           ws2.Cells(rowCnt, "u").PasteSpecial Paste:=xlPasteAll
                            
                            ElseIf main > subs Then             '4

                                'オッズTable上部の枠色付き軸番をコピー
                                    main.Copy
                                    
                                'Previewシートの紐番にペースト
                                    ws2.Cells(rowCnt, "u").PasteSpecial Paste:=xlPasteAll

                                'オッズTable左側の枠色付き紐番をコピー
                                    subs.Copy
                                    
                                'Previewシートの軸番にペースト
                                ws2.Cells(rowCnt, "t").PasteSpecial Paste:=xlPasteAll
                            
                End If
                        
                        If Odds <> 0 Then                   '5
                            ws2.Cells(rowCnt, "v") = Odds
                                
                                rowCnt = rowCnt + 1      ’６
                                
                                ElseIf Odds = 0 And main <> subs Then     '7
                                    ws2.Cells(rowCnt, "v") = "取消"
                                    
                                        rowCnt = rowCnt + 1
                                        
                                            ElseIf main = subs Then                ’8
                                                rowCnt = rowCnt
                                                
                        End If
         
            Next j
      
        Next i

             'コピー状態の解除
                Application.CutCopyMode = False

End Sub

かいせつ

Itemシートに作った見出しをコピペします
見出しの入力セル列T〜Vのセルを結合
Calcシートに作ったオッズテーブルから軸馬番/紐馬番/馬連オッズを取得します
変数i、変数jが列と行の移動を制御しています
軸馬番が紐馬番より小さい時の処理
軸馬番が紐馬番より大きい時の処理
オッズ入力セルが空欄でなければ列Vにオッズを入力
処理が終わるごとに1行下に移動させるためにrowCntを1増します
Calcシートの馬連オッズテーブルのオッズが空欄で、ゾロ目でなかったら”取消”を入力
軸馬番と紐枠番が同じならrowCntは1増させずそのままで次の処理にうつります

【馬単】Previewシートに組合せとオッズを縦列に表示

馬単を単勝人気順に表示するには「第6回券種ごとの・・・・・」で作ったオッズテーブルを使用します。マクロを説明するにあたりそこで制作したセル番地をベースにしています。

「第6回券種ごとの単勝人気順にオッズテーブル作成」で作成した馬単の人気順オッズテーブル

Sub 馬単人気順縦並べ()
    
    '-----------------------------------
    '   単勝人気順の馬単組合せとオッズを
    '   Previewシートに書込む
    '-----------------------------------
    
    Dim i As Integer, j As Integer
    Dim tosu As Long
    Dim main As Range
    Dim subs As Range
    Dim Odds As Single
    Dim rowCnt As Long

        Set ws2 = Worksheets("preview")
        Set ws4 = Worksheets("Calc")
        Set ws5 = Worksheets("Item")

            '馬単の見出しを作る                      '1
            With ws2
                ws5.Range("見出し_馬単").Copy .Range("x6")
                .Range(.Cells(6, "x"), .Cells(6, "z")).Merge
            End With
    
                rowCnt = 7                           '2
                
                    'Calcシートのs列馬番の入力セル数から頭数を割り出す
                    
                        tosu = Application.WorksheetFunction.CountA(ws4.Range("s44:s61"))
      
        For i = 1 To tosu
        
            For j = 1 To tosu

                    '軸番（main）                                   '3
                        Set main = ws4.Cells(67, 20 + i)
                    '紐番（substitute）
                        Set subs = ws4.Cells(68 + j, "s")
                     '馬単オッズの取得（馬単テーブルより取得）
                        Odds = ws4.Cells(68 + j, 20 + i)
                        
                If main <> subs Then                             ’4
                    
                    'オッズTable上部の枠色付き軸番をコピー
                        main.Copy
                        
                     'Previewシートの軸番にペースト
                         ws2.Cells(rowCnt, "x").PasteSpecial Paste:=xlPasteAll
                               
                        'オッズTable左側の枠色付き紐番をコピー
                          subs.Copy
                                
                        'Previewシートの紐番にペースト
                           ws2.Cells(rowCnt, "y").PasteSpecial Paste:=xlPasteAll

                                If Odds <> 0 Then
                                    ws2.Cells(rowCnt, "z") = Odds

                                        Else
                                            ws2.Cells(rowCnt, "z") = "取消"
  
                                End If
                                                
                End If

                        If main = subs Then                           '5
                                rowCnt = rowCnt
                                        
                                    Else
                                        rowCnt = rowCnt + 1         ’6
                                                
                        End If
         
            Next j
    
        Next i

             'コピー状態の解除
                Application.CutCopyMode = False

End Sub

かいせつ