【Excel】馬券ワイド総流しで複勝をワイドで追加する按分計算表作成

2021年7月5日2022年9月9日

複勝１点３万を超えたら、使えるワイド按分自動計算コピペ表

単勝と馬単では、あまり起こらない現象だが・・・複勝とワイドだと結構な割合で起こりえるワイド総流しの方が実は複勝よりも配当が高くなってしまっている説。

例：第71回安田記念GⅠ

レース結果（払戻）

着順	枠	馬番	馬名	タイム
1	枠7橙	11	ダノンキングリー	1:31.7
2	枠4青	5	グランアレグリア	アタマ
3	枠8桃	13	シュネルマイスター	1/2

単勝	11	4,760円	8番人気
複勝	11	710円	9番人気
	5	110円	1番人気
	13	240円	4番人気
枠連	4-7	720円	4番人気
馬連	5-11	2,950円	9番人気
馬単	11-5	12,090円	29番人気
ワイド	5-11	1,160円	12番人気
	11-13	5,460円	38番人気
	5-13	400円	3番人気
3連複	5-11-13	8,860円	26番人気
3連単	11-5-13	110,420円	247番人気

複勝とワイドを同額（9,000円）で購入した場合の払戻し額

複勝：⑪ 710円*9000＝\63,900-

ワイド：5-⑪ 1160円*3000=34,800　+　⑪-13 5460円*600=32,760 =\67,560-

※その差は3,660円となり、これが９万投資なら*10倍：36,600-となり、これが年間で数回あるとしたら・・・もうこれだけで年間収支のプラマイが左右するほどの出来事になってくるという訳。

複勝勝負している人なら、知っておいた方が良い勝負馬券だよね～（但し複勝５倍以上の大穴）

５倍以上の複勝馬券を買うなら「ワイド」総流しがウマい場合あり！

Excelで按分表を作る

※サンプルでは、倍率を手入力しなければいけないが・・・実際に使う場合
家だとＪＲＡホームページを見ながらコピペすれば良いので
コピペして自動で倍率が乗るようにすれば、「あ～ら簡単！」ってな感じになるかも知れない。

ただ現地やウインズの使用となると電源の問題やそもそもパソコンを持っていかないといけないので
出来ればスマホで使いたい！ということで
サンプルはスマホでMicrosoftアカウントを登録しての使用を前提にしている。

ただパソコンが使える環境ならば、倍率入力までもコピペで補ってしまおう～という考え。

さて、まぁここからのブログは既に上記記事でExcel表を作成できる前提で話しを進めていく。

コピペ按分表ひな型サンプル（こんな感じで作ってね～）

全体図

※全体のイメージだけ掴んでおくれ～必要部分は下記を参考！

部分的に拡大した画像も載せておく

左上

右中（ワイド～馬単～馬連）

上記表が作れたら、シート名を「原紙」として登録する

※これをコピーして使ったら次からはいちいち作らなくても良いのである。これで按分表の枠が出来たので、これにプロゴラム（ExcelVBA)を使えるようにして、オッズをコピペすだけで使える按分表にしていく作業に移ろう～～っと！

「名前を付けて保存」→「Excelマクロ有効ブック」で保存

ファイル拡張子「.xlsm」マクロが実行できるファイルとして登録し直す。

作成したブックにVBAを貼り付けて、プログラムを実行できるようにする

続いて、このマクロ付きのExcelを開き直し、「ALT＋F11」を押す。グラボ装着しているパソコンだと表示しない場合があるので、「表示→マクロ→編集」と進めるかメニューバーに開発が表示されていないなら、メニューバーを右クリックし、「リボンのユーザー設定」を表示させ、右の「開発」にチェックを入れ「開発→一番左のVisial Basicをクリックする」とVBAを編集できるエディターを表示させる。

「リボンのユーザー設定」→「開発」

既にモジュールがある場合はプログラムが表示され、一度もこのブックでVBAを作成実行していないなら、灰色の画面になっていると思うので、その場合は挿入で新規に標準モジュールを作成する。

「メニューバー　から　標準モジュール」　を選択する

※新しいモジュールが追加されたので、プログラム（VBA）を書ける準備ができた。

これで、私が下記で提供するモジュールをそのままコピペすれば「コピペ按分表」が完全に完成するのである。これで貴方もプログラマーの仲間入りだ！おっと勘違いしてはいけないよぉ～～

私が目指すのは、憧れのエンジニアでも、バリバリのプログラマーでもない！そう目指す頂は！！伝説のギャンブラー！。。。いやいや違うから、単に「年間収支＋のおじさん馬券師」なのですからね～～(￣▽￣)悪しからず。。。

そして、先に言っておくと、この按分表の性質上どんどんコピペして作成していく仕様のためVBAにシート名の制限をかけていない。つまり会社などでたくさんのExcelシートを表示させていて、このプログラムを動作させた場合、条件に合うセル値があるとプログラムが大事なデータを書き換えてしまう恐れがあるので、使用する場合は、ご自身のパソコンでご自身の責任において、処理を実行するようにされたし！この場合プロゴラムが暴走しているのではなく、利用者の注意不足による人的なミスなので、言葉すら、お間違いにならぬように注意しておく。

左下に「Module1」の表示があり、(General)の下に何もない白地であればＯＫ！

私の場合、既にこのプログラムを作成している状態なので、MSTMJというもう一つのモジュールがあるが、これは特に気にする必要はない。

下記のコードをCopyして、上記(General)の下にコピペすると完成！

※動作環境はMicrosoft365-2019だが、多分2016でも2013でも動作するとは思う。

クラウド上はダメ！ローカルにExcelがインストールされていないとVBAは動かない。

Dim TBL(18, 18) As Variant
    Dim SET_G As Integer, SET_R As Integer, SET_SA As Integer
    Dim RET As Variant, CNT As Integer, UBAN As Variant
    Dim i As Integer, j As Integer
Sub A1RC1Display()
    If Application.ReferenceStyle = xlA1 Then
        Application.ReferenceStyle = xlR1C1
    Else
        Application.ReferenceStyle = xlA1
    End If
End Sub
Function CHRCVT(r) As String
     If IsNull(r) Then
         CHRCVT = ""
     Else
         CHRCVT = Trim(r)
     End If
End Function
Sub 倍率セット()
    Application.ReferenceStyle = xlA1
    Call HYO_WIDE
    Call HYO_UREN
    Call HYO_UTAN
End Sub
Function TBLSET(g, r)
    Dim tousu As Integer
        
    SET_G = g
    SET_R = r
    
    For i = 0 To 18             '''0クリアー
        For j = 1 To 18
            TBL(i, j) = 0
        Next j
    Next i
    
    tousu = 0                   '''（ワイド）倍率コピペ列から出走頭数を把握
    For i = 0 To 20
        If tousu <= Cells(SET_G + i, SET_R) Then
            tousu = Cells(SET_G + i, SET_R)
        End If
    Next i
    
    Dim si1 As Integer, sj1 As Integer
    Dim wk_nm1 As Variant, wk_nm2 As Variant
    si1 = 0
    
    For i = 0 To 500
        If CHRCVT(Cells(SET_G + i, SET_R)) = "" _
          And CHRCVT(Cells(SET_G + i, SET_R + 1)) = "" _
          And CHRCVT(Cells(SET_G + 1 + i, SET_R)) = "" _
          And CHRCVT(Cells(SET_G + 1 + i, SET_R + 1)) = "" Then _
          Exit For
        
        If IsNumeric(CHRCVT(Cells(SET_G + i, SET_R))) Then
            If CHRCVT(Cells(SET_G + i, SET_R + 1)) = "" Then
                si1 = CHRCVT(Cells(SET_G + i, SET_R))
            Else
                sj1 = CHRCVT(Cells(SET_G + i, SET_R))
                wk_nm1 = CHRCVT(Cells(SET_G + i, SET_R + 1))
                If InStr(wk_nm1, "-") > 0 Then
                    wk_nm2 = Left(wk_nm1, InStr(wk_nm1, "-") - 1)
                    TBL(si1, sj1) = wk_nm2
                Else
                    TBL(si1, sj1) = wk_nm1
                End If
            End If
        End If
    Next i

End Function
Sub RITUSET()

    For CNT = 1 To 3
        UBAN = CHRCVT(Cells(1, CNT * 2 + SET_SA))
        
        If IsNumeric(UBAN) Then
            If Int(UBAN) >= 1 And Int(UBAN) <= 18 Then
                For i = 1 To 18
                    j = Int(Cells(SET_G + i - 1, SET_R + Int(UBAN) - 1))
                    If j > 0 Then
                        Cells(i + 1, CNT * 2 + SET_SA) = Int(Cells(SET_G + i - 1, SET_R + Int(UBAN) - 1))
                    Else
                        Cells(i + 1, CNT * 2 + SET_SA) = ""
                    End If
                    If Int(UBAN) = i Then
                        Cells(i + 1, CNT * 2 + SET_SA) = "--"
                    End If
                Next i
            End If
        End If
    Next CNT

End Sub
Sub HYO_WIDE()
    
    '''ワイドのコピペした行と列スタート位置をセット
    SET_G = 24
    SET_R = 12

    If CHRCVT(Cells(SET_G, SET_R)) = "" _
      And CHRCVT(Cells(SET_G, SET_R + 1)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R + 1)) = "" Then _
      Exit Sub
      
'---
    RET = TBLSET(SET_G, SET_R)


    '''ワイド：表を作成するスタート位置をセット
    SET_G = 24
    SET_R = 20
    SET_SA = 0
    
    Range("T24:AK41").Select
    Selection.ClearContents
    
    For i = 1 To 18
        For j = 1 To 18
            '''Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            If i > j Then
                Cells(SET_G + j - 1, SET_R + i - 1) = TBL(j, i)
            Else
                Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            End If
        Next j
    Next i
        
    '''選択した馬番の倍率を整数部のみセットして完了（ワイドはＢ列Ｄ列Ｆ列）
    Range("B2:B19,D2:D19,F2:F19").Select
    Selection.ClearContents
    
    Call RITUSET
    
    Range("B2").Select
    
End Sub

Sub HYO_UREN()

    '''馬連をコピペした行と列スタート位置をセット
    SET_G = 24
    SET_R = 16

    If CHRCVT(Cells(SET_G, SET_R)) = "" _
      And CHRCVT(Cells(SET_G, SET_R + 1)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R + 1)) = "" Then _
      Exit Sub

'---

    RET = TBLSET(SET_G, SET_R)

    '''馬連：表を作成するスタート位置をセット
    SET_G = 66
    SET_R = 20
    SET_SA = 14
    
    Range("T66:AK83").Select
    Selection.ClearContents
    
    For i = 1 To 18
        For j = 1 To 18
            '''Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            If i > j Then
                Cells(SET_G + j - 1, SET_R + i - 1) = TBL(j, i)
            Else
                Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            End If
        Next j
    Next i

    '''選択した馬番の倍率を整数部のみセットして完了（馬連はＰ列Ｒ列Ｔ列）
    Range("P2:P19,R2:R19,T2:T19").Select
    Selection.ClearContents
    
    Call RITUSET
       
    Range("P2").Select

End Sub

Sub HYO_UTAN()

    '''馬単のコピペした行と列スタート位置をセット
    SET_G = 24
    SET_R = 14

    If CHRCVT(Cells(SET_G, SET_R)) = "" _
      And CHRCVT(Cells(SET_G, SET_R + 1)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R)) = "" _
      And CHRCVT(Cells(SET_G + 1, SET_R + 1)) = "" Then _
      Exit Sub

'---

    RET = TBLSET(SET_G, SET_R)

    '''馬単：表を作成するスタート位置をセット
    SET_G = 45
    SET_R = 20
    SET_SA = 7
    
    Range("T45:AK62").Select
    Selection.ClearContents
    
    For i = 1 To 18
        For j = 1 To 18
            Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            'If i > j Then
            '    Cells(SET_G + j - 1, SET_R + i - 1) = TBL(j, i)
            'Else
            '    Cells(SET_G + j - 1, SET_R + i - 1) = TBL(i, j)
            'End If
        Next j
    Next i

    '''選択した馬番の倍率を整数部のみセットして完了（馬単はＩ列Ｋ列Ｍ列）
    Range("I2:I19,K2:K19,M2:M19").Select
    Selection.ClearContents
    
    Call RITUSET
       
    Range("I2").Select

End Sub