複勝１点３万を超えたら、使えるワイド按分自動計算コピペ表
単勝と馬単では、あまり起こらない現象だが・・・複勝とワイドだと結構な割合で起こりえるワイド総流しの方が実は複勝よりも配当が高くなってしまっている説。
例：第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
按分表の使い方
これで按分表が完成したので、オペレーションの説明に移る。
入力箇所は全部で８か所
①払戻金額を入力する（デフォルトは30,000）
②JRAホームページの単・複オッズをコピペする
③ワイドをコピペする
④馬単 〃
⑤馬連 〃
⑥⑦⑧ 馬番を入力する
「表示」→「マクロ」→「倍率セット」 を実行すると、コピペした各オッズが選択した馬番の下に自動的に入力される。
単・複をJRAホームページからコピペする
実際に単・複を計算では使用することは今のところはないが、馬券購入する上で必要な情報なのでデータとしてコピペしておくと、この表がどのレースのどの馬を対象にしたのか！というのが明確に分かる表として完結できるので、必ず入れるようにすると良い。
※ワイド・馬単・馬連も同様にコピペすれば良いので、画面サンプルは単・複だけの説明とする。
2021.7.4(sun) CBC賞を例にとり、原紙からコピーし狙いの馬３頭のオッズを按分計算してみるとしよう～～🤪
JRAホームページ ＣＢＣ賞の単・複オッズを表示させる
右クリック→コピー（CTRL+C）し、Excelシートの”A23″を右クリックし貼付ける
ワイド・馬単・馬連 を同じように貼り付ける
購入する馬番を入力する（今回は３頭選択している ⑪ ③ ①）
※これで全てのデータ入力が完了したので、マクロ（プログラム）を実行する。
「表示」→「マクロ」→「実行」
完成した按分表がこちら（ご自身のExcelで確認すれば良い！）
これで ”君” も今日から、めちゃんこ優秀なVBAプログラマーになってしまったのである。
編集後記
ExcelVBA本（プログラミング本）の選び方のコツ
- Amazon-Primeで物色
- Kindle-Unlimitedで物色
- 巻末の索引で「自分の探している命令」が載っている
- 目次で当たりを付ける
- 大型ブックオフ店で探す
- 大型書店で探す
- Amazonの★を気にしない
Excel VBA 逆引き大全 600の極意 Microsoft 365/Office 2021/2019/2016/2013対応
Excel VBA 逆引き大全 600の極意 Microsoft 365
※私が持っているのが2016年版（以下は2016）
- ExcelVBAの基本構文
- セルの操作
- 関数
- ワークシート、ウィンドウの操作
- ブック操作
- データ操作
- テーブル・ピボットテーブル
- 図形
- グラフ
- ユーザーフォーム
- 印刷
- ファイルとフォルダ
- データ連携
- イベント
- バージョン・トラブルシューティング・エラー処理
- 高度なテクニック
- 索引
目次が巻頭で検索が巻末。昔のタイプの本の構成だが、索引がページでなくTipsという見出しNo.になっていて慣れるまでは検索しづらい。
Amazonレビューは★3.9
それでは、またね～😎