inpOdsシートにプルダウンを追加
ここでは外部データとして第10回で作成した騎手/調教師成績のファイルを使います。
まず「第3回出馬表とオッズの取得」で作成したファイルのInpOdsシートのデザインを変更します。
かいせつ
- inpOdsシートのセルD3にプルダウンを作ります。
「リーディング情報」ではセルB4にプルダウンを作りましたが、今回はセルD3です。それを参考にセル位置などを置き換え、リストは以下のようにItemシートのx2:y12につくります。これで競馬場対応の先頭列番の値を取得することができます
標準モジュールを追加してマクロを記述
ここまで「第3回出馬表とオッズの取得」で作成したファイルに新規モジュールを追加して、第5回ではオリジナルの出馬表を作ってきました。今回もそのファイルに標準モジュールを追加し「f_リーディング」として、第10回で作成したファイル「リーディング情報」のランクを出馬表に反映させるマクロを記述していきます。なお二つのファイルは同じディレクトリにおいてください（同じフォルダにおきます）。
「b_出馬表作成」のオリジナル出馬表ができていれば、設定したフォントカラーやセルカラーが騎手、調教師名のセルに適用されます。
リーディング情報のランクを出馬表に反映させるマクロ
指定した開催場所のリーディング20位までを上位から4グループに分け、セル背景色やフォントカラーを設定します。
Option Explicit
Sub リーディング反映()
Dim i As Long, j As Long
Dim ws2 As Worksheet, ws3 As Worksheet, ws5 As Worksheet
Dim sh(1 To 2) As Worksheet
Dim tosu As Long
Dim jouTop As Integer
Dim srchKey As String
Dim srchRng As Range
Dim c(1 To 2) As Range
Dim srchName(1 To 2) As String
Dim firstAddress As String
Dim katisuRnk As Long, katirituRnk As Long
Dim rnkClm As Long
Dim nameClm As Long
Dim iroNo As Long, iroCode As Long
Dim buf As Long
'------------------------------------ _
騎手/調教師の勝数ベスト20のセル彩色 _ '1
【1位～5位,6～10,11～15,16～20】 _
-------------------------------------
Set ws2 = Worksheets("Preview")
Set ws3 = Worksheets("InpOds")
Set ws5 = Worksheets("Item")
'Previewシートのc列馬番の最大値をもとめて該当レースの頭数を割り出す
tosu = Application.WorksheetFunction.Max(ws2.Range("c7:c24"))
'ファイル「リーディング情報」を開く
Workbooks.Open Filename:=ThisWorkbook.Path & "¥リーディング情報.xlsm" '2
'「リーディング情報」の競馬場Top列を取得
Set srchRng = ws5.Range("x2:y12") '３ Itemシートの競馬場名とそのTop列
srchKey = ws3.Range("d3")
jouTop = WorksheetFunction.VLookup(srchKey, srchRng, 2, False) '4
'「リーディング情報」の列位置（騎手/調教師 共通） '5
rnkClm = jouTop '勝利数ランクの列位置
nameClm = jouTop + 1 '騎手/調教師名の列位置
下に続く↓
かいせつ
- ここでは1位から20位までを4分割して、セルの塗りやフォントのカラーをグループごとに設定します。自分流にアレンジして30位まで3分割にするとか、カラーを違ったものにできます
- 現在このマクロを記述しているBookと同じフォルダーにある「”リーディング情報.xlsm”」を開きます
リーディング情報はExcelマクロ有効ブックで保存しているので拡張子xlsmです。拡張子を忘れるとエラーになりますので忘れずに記述してください
¥はファイルパスで、ディレクトリやファイル名の区切り記号として使用されます。”¥”と”\”（バックスラッシュ）は文字コードが同じなので自分の環境ではどちらでも問題なく使っています - srchRngはItemシートに作ったプルダウンリスト範囲を指定、srchKeyはプルダウンで選択した競馬場です
- VLOOKUP関数を使いsrchKeyで指定した競馬場の「リーディング情報」ファイルでそこの先頭行を求めます
- 競馬場ごとのデータ先頭列が勝数順位、先頭列の次列が騎手名（調教師名）になっています
上から続く↑ For i = 1 To tosu '検索のリセット Application.FindFormat.Clear '「Preview」出馬表の検索する騎手/調教師名列位置 '1 srchName(1) = ws2.Cells(6 + i, "k") '騎手名 srchName(2) = ws2.Cells(6 + i, "l") '調教師名 '減量騎手は名前の頭に☆などがつくので除去してから検索 '2 'Previewでは☆などつけたまま表示 If Left(srchName(1), 1) = "☆" Or _ Left(srchName(1), 1) = "△" Or _ Left(srchName(1), 1) = "▲" Or _ Left(srchName(1), 1) = "★" Or _ Left(srchName(1), 1) = "◇" Then srchName(1) = Replace(srchName(1), Left(srchName(1), 1), "") '検索騎手名 End If For j = 1 To 2 '3 'ファイル「リーディング情報」のシート Set sh(1) = Worksheets("Jockey") Set sh(2) = Worksheets("Trainer") '「リーディング情報」の騎手/調教師の勝数ランクを検索する With sh(j) '4 Set c(j) = .Range(.Cells(4, nameClm), .Cells(43, nameClm)) _ .Find(what:=srchName(j), LookAt:=xlPart, SearchFormat:=True) End With If Not (c(j) Is Nothing) Then '5 firstAddress = c(j).Address '検索騎手アドレス '==勝数ランクの処理== katisuRnk = sh(j).Cells(c(j).Row, rnkClm) 勝利数ランク列 '騎手/調教師 勝数ランク20以内の塗り Select Case katisuRnk '6 Case 1 To 5 'ランク1～5位 iroNo = 16770559 '塗りピンク Case 6 To 10 'ランク6～10位 iroNo = 13434828 '塗り薄緑 Case 11 To 15 'ランク11～15位 iroNo = 16772300 '塗り空色 Case 16 To 20 'ランク16～20位 iroNo = 10092543 '塗りクリーム Case Else 'ランク21位以下塗り白 iroNo = 16777215 '塗り白 End Select ws2.Cells(6 + i, 10 + j).Interior.Color = iroNo '==勝率ランクの処理== If jouTop = 5 Then '7 buf = 15 Else buf = 14 End If katirituRnk = sh(j).Cells(c(j).Row, rnkClm + buf) '8 勝率ランク列 '勝率ランク20以内のフォントカラー Select Case katirituRnk '9 Case 1 To 5 '勝率 1～5位 iroCode = 3 'フォント赤 Case 6 To 10 '勝率 6～10位 iroCode = 50 'フォント濃緑 Case 11 To 15 '勝率 11～15位 iroCode = 23 'フォント濃青 Case 16 To 20 '勝率 16～20位 iroCode = 45 'フォントオレンジ Case Else '勝率 21位以上塗りなし End Select '勝数ランク20位以内で _ 勝率ランク20位以内についてはフォント彩色・太字 If katisuRnk < 21 And katirituRnk < 21 Then ws2.Cells(6 + i, 10 + j).Font.ColorIndex = iroCode ws2.Cells(6 + i, 10 + j).Font.Bold = True '勝数ランク21位以上で _ 勝率ランク20位以内についてはフォント斜体 ElseIf katisuRnk >= 21 And katirituRnk < 21 Then ws2.Cells(6 + i, 10 + j).Font.ColorIndex = iroCode ws2.Cells(6 + i, 10 + j).Font.Italic = True '勝数ランク21位以上で勝率ランク21位以上 Else ws2.Cells(6 + i, 10 + j).Font.ColorIndex = xlColorIndexNone End If End If Next j Next i Workbooks("リーディング情報.xlsm").Close '10 End Sub
かいせつ
- srchName(1)の括弧内の数字は「For j=1to2」に対応しており、「１」は騎手名「２」は調教師名
- 女性騎手および見習騎手の場合、出馬表の騎手名の前に△などの記号がありますがリーディング情報にはないので、双方の騎手名表示形式を揃える必要があります。出馬表の騎手名でリーディング情報に検索をかけるので、記号を取り除いた騎手名を変数srchName(1)に格納します
- 変数「j」が1のとき騎手、2の場合は調教師のデータを操作します
- 「j=1」のケースではJockeyシートの検索範囲に、検索騎手名があるか調べます
- obj is Nothingという比較演算子をNot演算子で論理否定すれば「Nothingではない」という判定、つまり検索した騎手名は存在ということになります。あった場合その騎手のJockeyシート上のアドレスから勝数順位を取得します
- 勝数ランクに応じてセルの塗り色を設定します
- 勝率順位の列は全国は先頭列から15列目、各競馬場の場合は14列目になります
- 勝率順位を求めてフォントをランクに応じて処理します
- Select Caseステートメントを使用して複数の条件により処理を分岐させます。If文は分岐の数が多いときに使用すると読みにくくなります
- ブック「リーディング情報」を閉じます
コメント