騎手リーディングデータを削除して入力先頭列にジャンプ
ここでのマクロはB4セルのプルダウンで指定した競馬場の騎手データを消去後、その競馬場トップ列にジャンプしてペーストを待ちます。アクティブシートに適用されるので、このマクロはJockeyとTrainerは共通です。では、標準モジュールを追加して以下のマクロを書いていきます。
Option Explicit
Dim jmp_topClm As Integer '1
Sub data_del()
'====================================================
' 指定した競馬場のランクを消去してコピペの準備
' Jockey Trainer共通（アクティブシートに適用）
'====================================================
Dim delRng As Range
Dim ws As Worksheet
Dim srchKey As Range
Dim srchRng As Range
Dim jmp_btmClm As Long
Set ws = Worksheets("Item")
Set srchRng = ws.Range("b3:d13") '2 Itemの競馬場一覧表
Set srchKey = Range("b4") '3 Jockey Trainerシートの競馬場指定欄
'指定競馬場の先頭列番取得
jmp_topClm = WorksheetFunction.VLookup(srchKey, srchRng, 3, False) '4
'指定競馬場のデータ消去
If jmp_topClm = 5 Then '全国は5列目（全国の時適用）
jmp_btmClm = jmp_topClm + 16 '5
Else
jmp_btmClm = jmp_topClm + 15 '6
End If
Set delRng = Range(Cells(4, jmp_topClm), Cells(43, jmp_btmClm))
delRng.ClearContents
'指定競馬場のTop列に移動してペーストを待つ
Cells(4, jmp_topClm).Select
End Sub
Sub Rank_paste() '7
・・・・・
・・・・・・
End Sub
Sub Ranking() '8
・・・・・・・
・・・・・・・
End Sub
かいせつ
- このあと作成する複数のプロシージャがあり、変数jmp_clmTopを共有したいので、この位置で変数を宣言
- Itemシートに作成した全国と10競馬場のリスト範囲
- アクティブシートB4セルのプルダウンメニューで選択した競馬場名
VLOOKUP（検索値, 範囲, 列番号, 検索の型）を使って指定競馬場のTop列に移動します
検索値・・・〈srchKey〉セルB4で選択した競馬場名
範囲・・・・〈srchRng〉ItemシートB3〜D13の表で、競馬場名と先頭列の範囲
列番号・・・取り出したい値がリスト表範囲の左から何列目にあるか、つまり競馬場の先頭列を知りたいので「３」を指定
検索の型・・完全に一致する値を探すことのほうが多いので、とりあえず「FALSE」- VLOOKUPで取得した先頭列位置のjmp_topClmが「5」のケースでは、16列分が全国のデータ範囲なのでjmp_btmClmはjmp_topClm+16になります
- 全国のデータでない時は「通算勝利数」の項目がなく1列少ないので、jmp_btmClmはjmp_topClm+15になります
- 「リーディングをコピペする」のマクロを同一モジュール内に書いていきます
- 「騎手の勝率・連対率にランクをつける」のマクロを続けて書きます
リーディングをコピペする
ここまで、例えば全国のリーディングデータを消去したら、アクティブセルがE4に移動というマクロを作りました。つぎは移動したセルE4にコピーしたデータをショートカットキー[cntl+a]を使ってペーストするマクロです。
Sub Rank_paste()
'（ctrl+a）で実行 '8
'Jockey Trainer共通のマクロ
'=====================================
' JRAのHPからリーディングをコピー後
' ペースト処理するマクロ
'======================================
Dim rowAdd4 As Integer '行位置初期値
Dim rowAdd As Integer 'アクティブセルの行アドレス
Dim clmAdd As Integer 'アクティブセルの列アドレス
rowAdd4 = 4 '指定馬場の先頭行
rowAdd = ActiveCell.Row '指定馬場でアクティブセルを指定済み
clmAdd = ActiveCell.Column '指定馬場でアクティブセルを指定済み
'貼付け先の書式に合わせてペースト
ActiveSheet.PasteSpecial _
Format:="HTML", _
Link:=False, _
DisplayAsIcon:=False, _
NoHTMLFormatting:=True
'正しく複写されていない場合は複写データを消去して再コピー _
ランク1位～20位の処理
If Cells(rowAdd4 + 1, clmAdd) = "" Then '1 正しく複写されていない場合はE5が空欄
Cells(rowAdd4, clmAdd).ClearContents ’＊
Cells(rowAdd4, jmp_topClm).Value = "再度コピーしてください" '2
Exit Sub
ランク1位～20位は正常に複写済み _
ランク21位～40位が正しく複写されていない場合は _
複写データを消去して再コピー '3
ElseIf Cells(rowAdd4 + 1, clmAdd) <> "" And _
Cells(rowAdd + 1, clmAdd) = "" Then
Cells(rowAdd, clmAdd).Value = "再度コピーしてください"
Exit Sub
Else
rowAdd = rowAdd + 20 '4 セル行位置を20行下に設定
Cells(rowAdd, clmAdd).Select
End If
'ランク40位までペーストしたら、ランク付けをする '5
If rowAdd = 44 Then
Call Ranking '6
Range("b4").Select ’ topの競馬場選択セルに移動 '7
End If
End Sub
かいせつ
- [cntl+a]でペーストしたとき正常にコピーができていない場合、下図AのようにE4セルのみにペーストされE5が空欄であることが確認できます。この状態になったときは＊印の命令文でE4のセル内容を消去します
- E4のセル内容を消去したあと、上図BのようにE4セルに「再度コピーしてください」とメッセージが表示されプロシージャを抜けます
そのときはコピー先を一度解除し、再選択後コピーし直してから[cntl+a]でペーストしてください。再選択をしないでそのままコピーをしても正しくコピーされていないので「再度コピーしてください」とメッセージがでます - リーディングの21位から40位のコピーについても「２」と同様のチェックをします
- リーディング1位から20位のペーストが済んだら先頭列の20行下にセルが移動して、つぎのペーストの準備をします。Jockeyシートのレイアウトを同じように作っていれば、21から40位のペースト後、セルの行位置は20行下の44になります
- セルの行位置が44ということは1位〜40位までのペーストが終わったことを意味しますので、データに基づき勝率と連対率のランク付けをします
- プロシージャRankingを呼び出します
- セルB4に移動して終了です
- Rank_pasteが書き終わったらショートカットキーの設定をします。ここでは[cntl+a]にしています
注意：「第3回の出馬表とオッズの取得」でショートカットキーに[cntl+a]を設定しているので、ここでも同じキーを設定した場合、２つのファイルを同時に開いた状態で[cntl+a]を押下すると思わぬエラーになります。対策として別のキーを設定するか、同一のショートカットキーを設定したファイルを意味なく同時に開いておかないことです。
騎手の勝率・連対率にランクをつける
リーディングデータは勝ち数順に並んでいます。勝ち数が上位でも騎乗回数が多く勝率は良くない場合もあります。どちらを重視するかは人それぞれですが、ここでは勝率と連対率のランク付けをします。下記プロシージャ中、青文字部分はJRAの現リーディングデータでは不要ですので書かなくても問題ありません。
Sub Ranking()
'====================================
'騎手・調教師のランク付け
'====================================
Dim ws As Worksheet
Dim i As Long
Dim winRate As Long
Dim ofSet As Long
Dim endRow As Integer
Dim c As Range
Dim fndRow As Long
Set ws = Worksheets("Item")
winRate = jmp_topClm + 10 '1データの勝率セル列
'指定馬場で全国選択時のTop列
If jmp_topClm = 5 Then '全国のランキング
ofSet = 5 '２ 勝率列から5列移動して勝率順位記入
'競馬場別の場合のTop列
ElseIf jmp_topClm <> 5 Then '競馬場別ランキングの場合
ofSet = 4 '３ 勝率列から4列移動して勝率順位記入
End If
'各競馬場データの最終行検出
endRow = Cells(Rows.Count, winRate).End(xlUp).Row
'i=0は項目の勝率列 i=1は項目の連対率列
For i = 0 To 1 '4
winRate = winRate + i
For Each c In Range(Cells(4, winRate), Cells(endRow, winRate))
c.Offset(0, ofSet) = Application.WorksheetFunction.Rank _
(c.Value, Range(Cells(4, winRate), Cells(endRow, winRate)), 0) '5
Next c
Next i
'■■■ランキングの騎手名欄 の処理 ’６
Dim nameRng As Range
Dim txt As String
Dim findStr As Variant
'騎手ランキング検索範囲（札幌～小倉）
Set nameRng = Range(Cells(4, jmp_topClm + 1), Cells(endRow, jmp_topClm + 1))
'外国人騎手のピリオドを全角から半角にする _
免許を有さない騎手の頭についている「＊」をとる
For Each c In nameRng
txt = c.Value
txt = Replace(txt, "．", ".") '全角を半角に
txt = Replace(txt, "＊", "") '「＊」をとる
c.Value = txt
Next c
For Each c In nameRng
'外国人騎手の全角英字を半角英字に置き換え
'置き換え対象外の左から2文字目以降（100文字までにしてある）
findStr = Mid(c.Value, 2, 100)
'1文字目が全角英字なら半角英字に変換
If Left(c.Value, 1) Like "[Ａ-Ｚ]" Then
findStr = StrConv(Left(c.Value, 1), vbNarrow) & findStr
Else
findStr = Left(c.Value, 1) & findStr
End If
c.Value = findStr
Next c
'更新済みの競馬場名の入力 7
fndRow = Cells(20, "b").End(xlUp).Row
Cells(fndRow + 1, "b").Value = Range("b4").Value
End Sub
かいせつ
- 全国や各競馬場データのTop列はプロシージャdata_del内のjmp_topClmで取得済みなので、そこから数えて10列目が勝率の列位置になります
- 項目の「勝率」から数えて5列移動した位置が勝率の順位を書込む列になります
- 競馬場ごとのデータには全国にある項目「通算勝利数」がないので、勝率順位を書込む列は「勝率」列から数えて4列目となります
- For Next文を使って勝率と連対率の条件分岐してます
i=0は勝率列、i=1なら連対率での順位を計算します - 勝率順位列、連対順位列にそれぞれの順位を書込みます
- 以前のJRAの騎手・調教師のリーディングは、出馬表のそれとは表記が一致していませんでした。そのため青文字のコード部分で、余計な空白やら外国人騎手の表記を出馬表のものと揃えて、検索できるようにする必要がありました。現在は不要ですがそのコードを載せておきますので、またリーディング情報の表記が変更になったときは参考にしてください
- プルダウンで指定した騎手の競馬場別リーディングのコピペが終了したときのに、更新した競馬場名をセルB14以下に入力します
B列はB13に「更新済み」とあらかじめ入力していますので、B14以下は空欄です。とりあえずB20を選択後、ENDプロパティを使って文字入力してあるセルの最終行を取得し、そこから1行下に更新済みの競馬場名を入力します。3開催だったら3競馬場が入力され、コピペ済みのそれが確認できます。確認が済んだら手動で消去するか、ボタンを配置して消去範囲を指定したマクロを登録します
これでJockeyシートの「全国」のレイアウトとマクロができ上がりました。フォームコントロールボタン「指定馬場消去&入力」に「Sub data_del ()」をマクロ登録してください。
コメント