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

目次

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

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

例:第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円となり、これが9万投資なら*10倍:36,600-となり、これが年間で数回あるとしたら・・・もうこれだけで年間収支のプラマイが左右するほどの出来事になってくるという訳。

複勝勝負している人なら、知っておいた方が良い勝負馬券だよね~(但し複勝5倍以上の大穴)

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

Excelで按分表を作る

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

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

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

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

コピペ按分表ひな型サンプル(こんな感じで作ってね~)

全体図

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

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

左上
右中(ワイド~馬単~馬連)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

私の場合、既にこのプログラムを作成している状態なので、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
        
    '''選択した馬番の倍率を整数部のみセットして完了(ワイドはB列D列F列)
    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

    '''選択した馬番の倍率を整数部のみセットして完了(馬連はP列R列T列)
    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

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

End Sub

按分表の使い方

これで按分表が完成したので、オペレーションの説明に移る。

入力箇所は全部で8か所

①払戻金額を入力する(デフォルトは30,000)

②JRAホームページの単・複オッズをコピペする

③ワイドをコピペする

④馬単 〃

⑤馬連 〃

⑥⑦⑧ 馬番を入力する

「表示」→「マクロ」→「倍率セット」 を実行すると、コピペした各オッズが選択した馬番の下に自動的に入力される。

単・複をJRAホームページからコピペする

実際に単・複を計算では使用することは今のところはないが、馬券購入する上で必要な情報なのでデータとしてコピペしておくと、この表がどのレースのどの馬を対象にしたのか!というのが明確に分かる表として完結できるので、必ず入れるようにすると良い。

※ワイド・馬単・馬連も同様にコピペすれば良いので、画面サンプルは単・複だけの説明とする。

2021.7.4(sun) CBC賞を例にとり、原紙からコピーし狙いの馬3頭のオッズを按分計算してみるとしよう~~🤪

JRAホームページ CBC賞の単・複オッズを表示させる
右クリック→コピー(CTRL+C)し、Excelシートの”A23″を右クリックし貼付ける
ワイド・馬単・馬連 を同じように貼り付ける
購入する馬番を入力する(今回は3頭選択している ⑪ ③ ①)

※これで全てのデータ入力が完了したので、マクロ(プログラム)を実行する。

「表示」→「マクロ」→「実行」
完成した按分表がこちら(ご自身のExcelで確認すれば良い!)

これで ”君” も今日から、めちゃんこ優秀なVBAプログラマーになってしまったのである。

編集後記

ExcelVBA本(プログラミング本)の選び方のコツ

  • 近くの大きな書店で実物を閲覧(コレが一番良い)
  • 巻末の索引で「自分の探している命令」が載っている

が、そもそもデカい本屋が近くにない!という場合は?

  • Kindle-Unlimitedで物色するのが一番簡単で速い
  • 巻末の索引で「自分の探している命令」が載っている

巻末が見れない場合は、目次で当たりを付けるしかない。

  • Kindle試し読み
  • 自分の探している命令が目次にある
  • それらしき文言から推測する
  • ビンゴで命令がなければメモしておき本屋訪問時に一気買い

これが★を参考にするよりも自分の正解に辿り着く、一番の近道となる!

今回の記事だと、「DoEvents関数」なので、コレが載っている本を探すことになる。

それでは、またね~😎

この記事を書いた人

マクロで半自動化!GO!GO!!PROGRAMMING
管理人:あどのまつり
馬齢:牡50代(後)✖1

2023年はコロナ明けでタイ旅行にいきThai!!

目次