Previewシートに組合せとオッズを並列に表示
オッズの並列表示例です。Previewシートに単勝人気順の組合せで並べます。
【枠連】単勝人気順の組合せ並列表示のマクロをつくる
馬連を単勝人気順に表示するには「第6回 券種ごとの・・・・・」で作ったオッズテーブルを使用します。マクロを説明するにあたり、そこで制作したセル番地をベースにしています。
Sub 枠連人気順横並べ()
'------------------------------------
' 単勝人気順の枠連組合せとオッズを
' Previewシートに書込む
'------------------------------------
Dim i As Integer, j As Integer
'P_⇒ Previewシート 1
Dim P_main As Range
Dim P_subs As Range
Dim P_odds As Range
'C_⇒ Calcシート 2
Dim C_main As Range
Dim C_subs As Range
Dim C_odds As Range
Set ws2 = Worksheets("preview") ’3
Set ws4 = Worksheets("Calc")
Set ws5 = Worksheets("Item")
'枠連の見出しを作る ’4
With ws2
ws5.Range("見出し_枠連").Copy .Range("p6")
.Range(.Cells(6, "p"), .Cells(6, "r")).Merge
End With
For i = 1 To 8
For j = 1 To 9 - i
'■Calcシートのセル位置 ’5
'軸番（main）
Set C_main = ws4.Cells(25, 20 + i)
'紐番（substitute）
Set C_subs = ws4.Cells(25 + i + j, "s")
'枠連オッズの取得（枠連テーブルより取得）
Set C_odds = ws4.Cells(25 + i + j, 20 + i)
'■Previewシートのセル位置 '6
'軸番（main）
Set P_main = ws2.Cells(6 + j, 16 + (i - 1) * 4)
'紐番（substitute）
Set P_subs = ws2.Cells(6 + j, 17 + (i - 1) * 4)
'枠連オッズの取得（枠連テーブルより取得）
Set P_odds = ws2.Cells(6 + j, 18 + (i - 1) * 4)
'人気順枠組合せの作成(4-3を3-4のように直す） 7
If C_main < C_subs Then
'オッズTable上部の枠色付き軸番をコピー
C_main.Copy
'Previewシートの軸番にペースト
P_main.PasteSpecial Paste:=xlPasteAll
'オッズTable左側の枠色付き紐番をコピー
C_subs.Copy
'Previewシートの紐番にペースト
P_subs.PasteSpecial Paste:=xlPasteAll
Else 'C_main>C_subs C_main=C_subs（ゾロ目）のケース ８
'オッズTable上部の枠色付き軸番をコピー
C_main.Copy
'Previewシートの紐番にペースト
P_subs.PasteSpecial Paste:=xlPasteAll
'オッズTable左側の枠色付き紐番をコピー
C_subs.Copy
'Previewシートの軸番にペースト
P_main.PasteSpecial Paste:=xlPasteAll
End If
If C_odds <> 0 Then '9
C_odds.Copy P_odds
Else
P_odds = "" '10
End If
Next j
Next i
'コピー状態の解除
Application.CutCopyMode = False
End Sub
かいせつ
- Previewシートで使うRangeオブジェクトを格納する変数を定義
- Calcシートで使うRangeオブジェクトを格納する変数を定義
[1][2]のようにまとめて変数を定義した方が縦列表示マクロと比較してみやすいです - ワークシートオブジェクト変数は[Sub 枠連人気順縦並べ]のプロシージャの上で定義しているので当該モジュール内に適用されます
- 枠連の見出しをコピペしてセルを結合します
- Calcシートの軸枠番/紐枠番/オッズのセル位置をForNextの<i> <j>で制御
- Previewシートの軸枠番/紐枠番/オッズのセル位置をForNextの<i> <j>で制御
- 軸枠番が紐枠番より小さい時の処理
- 軸枠番が紐枠番より大きいと時、ゾロ目時の処理
- テーブルのオッズが空欄でなければオッズのコピペ
- テーブルのオッズが空欄ならPreviewシートのオッズセルも空欄にします
【馬連】単勝人気順の組合せ並列表示のマクロをつくる
馬連を単勝人気順に表示するには「第6回 券種ごとの・・・・・」で作ったオッズテーブルを使用します。マクロを説明するにあたり、そこで制作したセル番地をベースにしています。
Sub 馬連人気順横並べ()
'------------------------------------
' 単勝人気順の馬連組合せとオッズを
' Previewシートに書込む
'------------------------------------
Dim i As Integer, j As Integer
Dim tosu As Long
Dim lastRow As Long
Dim actClm As Long
'P_⇒ Previewシート '1
Dim P_main As Range
Dim P_subs As Range
Dim P_odds As Range
'C_⇒ Calcシート '2
Dim C_main As Range
Dim C_subs As Range
Dim C_odds As Range
Set ws2 = Worksheets("preview")
Set ws4 = Worksheets("Calc")
Set ws5 = Worksheets("Item")
'Calcシートのs列馬番の入力セル数から頭数を割り出す
tosu = Application.WorksheetFunction.CountA(ws4.Range("s44:s61"))
lastRow = ws2.Cells(Rows.Count, 16).End(xlUp).Row '3
'馬連の見出しを作る '4
With ws2
ws5.Range("見出し_馬連").Copy .Cells(lastRow + 2, "p")
.Range(.Cells(lastRow + 2, "p"), .Cells(lastRow + 2, "r")).Merge
End With
For i = 1 To tosu
If i <= 9 Then ’5
lastRow = lastRow + 1
actClm = i
ElseIf i >= 10 Then '6
lastRow = lastRow + tosu + 1
actClm = i - 9
End If
For j = 1 To tosu + 1 - i
'■Calcシートのセル位置 7
'軸番（main）
Set C_main = ws4.Cells(42, 20 + i)
'紐番（substitute）
Set C_subs = ws4.Cells(42 + i + j, "s")
'馬連オッズの取得（馬連テーブルより取得）
Set C_odds = ws4.Cells(42 + i + j, 20 + i)
'■Previewシートのセル位置 8
'軸番（main）
Set P_main = ws2.Cells(lastRow + j, 16 + (actClm - 1) * 4)
'紐番（substitute）
Set P_subs = ws2.Cells(lastRow + j, 17 + (actClm - 1) * 4)
'枠連オッズの取得（枠連テーブルより取得）
Set P_odds = ws2.Cells(lastRow + j, 18 + (actClm - 1) * 4)
'単勝人気順の馬組合せの作成(4-3を3-4のように直す）ゾロ目は書き込まない
If C_main < C_subs Then '9
'オッズTable上部の枠色付き軸番をコピー
C_main.Copy P_main
'オッズTable左側の枠色付き紐番をコピー
C_subs.Copy P_subs
ElseIf C_main > C_subs Then '10
'オッズTable上部の枠色付き軸番をコピー
C_main.Copy P_subs
'オッズTable左側の枠色付き紐番をコピー
C_subs.Copy P_main
End If
If C_odds <> 0 Then ’11
C_odds.Copy P_odds
ElseIf C_odds = 0 And C_main <> C_subs Then '12
P_odds = "取消"
End If
Next j
If i <= 9 Then '13
lastRow = lastRow - 1
ElseIf i >= 10 Then
lastRow = lastRow - tosu - 1
End If
Next i
'コピー状態の解除
Application.CutCopyMode = False
End Sub
かいせつ
- Previewシートで使うRangeオブジェクトを格納する変数を定義
- Calcシートで使うRangeオブジェクトを格納する変数を定義
- データが入力されている最終行を求め、初期値として変数lastRowに格納
[Rows,Count]の部分はExcelシート全体の行数を表わす。Excel2007以降1,048,576行です。Rows,Count,16はp列の最終行のセルを表わす。つまりp1,048,576を指します
Endモードで一気にデータが入っている行まで上にジャンプするのが .End（xlUp）ということになる。.Rowがデータが入力されている最終行になります - あらかじめitemシートに作っておいた「見出し馬連」をコピペし、セルの結合
1番人気から9番人気までの軸馬番は上段に、10番人気以降は下段に表示します。iの値は人気でi=1なら軸馬1番人気、同 i=2なら2番人気となり、列移動を制御する変数です。
- i<=9の場合はPreviewシート馬連上段の表示列位置の初期値
- i>=10は下段に表示するためのセル列位置の初期値
- Calcシートの軸馬番/紐馬番/オッズのセル位置をForNextの<i> <j>で制御します
- Previewシートの軸馬番/紐馬番/オッズセル位置をForNextの<i> <j>で制御します
- 軸馬番が紐馬番より小さい時の処理
- 軸馬番が紐枠番より大きい時の処理
- Calcシートのオッズテーブルの当該オッズが空欄でなければPreviewシートにオッズを入力
- 当該オッズが空欄で組合せがゾロ目でない時は「取消」と入力
- ForNextでiに対するjの繰り返しが終了したら変数lastRowを再設定します
※なおlastRowについては再考の余地があると感じます
Sub 馬単人気順横並べ()
'-----------------------------------
' 単勝人気順の馬単組合せとオッズを
' Previewシートに書込む
'-----------------------------------
Dim i As Integer, j As Integer
Dim tosu As Long
Dim lastRow As Long
Dim actClm As Long
Dim rowCnt As Long
'P_⇒ Previewシート
Dim P_main As Range
Dim P_subs As Range
Dim P_odds As Range
'C_⇒ Calcシート
Dim C_main As Range
Dim C_subs As Range
Dim C_odds As Range
Set ws2 = Worksheets("preview")
Set ws4 = Worksheets("Calc")
Set ws5 = Worksheets("Item")
'Calcシートのs列馬番の入力セル数から頭数を割り出す
tosu = Application.WorksheetFunction.CountA(ws4.Range("s44:s61"))
lastRow = ws2.Cells(Rows.Count, 16).End(xlUp).Row
'馬単の見出しを作る
With ws2
ws5.Range("見出し_馬単").Copy .Cells(lastRow + 2, "p")
.Range(.Cells(lastRow + 2, "p"), .Cells(lastRow + 2, "r")).Merge
End With
For i = 1 To tosu
If i <= 9 Then
rowCnt = lastRow + 3
actClm = i
ElseIf i >= 10 Then
rowCnt = lastRow + tosu + 3
actClm = i - 9
End If
For j = 1 To tosu
'■Calcシートのセル位置
'軸番（main）
Set C_main = ws4.Cells(67, 20 + i)
'紐番（substitute）
Set C_subs = ws4.Cells(68 + j, "s")
'馬連オッズの取得（馬連テーブルより取得）
Set C_odds = ws4.Cells(68 + j, 20 + i)
'■Previewシートのセル位置
'軸番（main）)
Set P_main = ws2.Cells(rowCnt, 16 + (actClm - 1) * 4)
'紐番（substitute）
Set P_subs = ws2.Cells(rowCnt, 17 + (actClm - 1) * 4)
'枠連オッズの取得（枠連テーブルより取得）
Set P_odds = ws2.Cells(rowCnt, 18 + (actClm - 1) * 4)
If C_main <> C_subs Then
'オッズTable上部の枠色付き軸番をコピー
C_main.Copy P_main
'オッズTable左側の枠色付き紐番をコピー
C_subs.Copy P_subs
End If
If C_odds <> 0 Then
C_odds.Copy P_odds
ElseIf C_odds = 0 And C_main <> C_subs Then
P_odds = "取消"
End If
If C_main <> C_subs Then
rowCnt = rowCnt + 1
ElseIf C_main = C_subs Then
rowCnt = rowCnt
End If
Next j
Next i
'コピー状態の解除
Application.CutCopyMode = False
End Sub
かいせつ
馬単の人気順横並べについては軸馬番と紐馬番の入れ替えもなく、ここまでの「かいせつ」で理解できると思います。
出馬表とオッズを取得してからここまでの一連のマクロをまとめて実行するには・・・
簡単な方法としてとりあえず、Sub 実行()とかのプロシージャをつくり実行したい順に、Callステートメントで呼び出すプロシージャを指定します。そしてシート上にボタンを作ってSub 実行()を登録すれば簡単にマクロを実行できます。
入力範囲の消去は「第5回オリジナルの出馬表を作成する」で作った「Sub入力オッズと出馬表消去」の消去範囲を修正・再設定をして、コマンドボタンに消去のプロシージャを登録します
納得できるソフトを作るまでには何度も修正を重ねます。あとで理解しやすくするためにも適切なコメントをつけます。コメント文は、先頭にシングルクオーテションを「 ‘」 付けます。コメントアウトされたコードはプログラム実行時には無視され、実行されません。
コメント