🐤④読込データの表示とクリア
Sub Oz色()
If Oz(Uma) = 0 Then
MyColor = 1
ElseIf Oz(Uma) < 4 Then
MyColor = 3
ElseIf Oz(Uma) < 10 Then
MyColor = 46
ElseIf Oz(Uma) < 50 Then
MyColor = 32
Else
MyColor = 1
End If
End Sub
Sub 回収色()
If E >= 100 Then
MyColor = 42
ElseIf E >= 90 Then
MyColor = 41
ElseIf E >= 83 Then
MyColor = 4
ElseIf E >= 77 Then
MyColor = 27
ElseIf E >= 65 Then
MyColor = 3
ElseIf E = 0 Then
MyColor = 48
Else
MyColor = 18
End If
End Sub
Sub 枠変()
Waku = Int((Uma - (UmaAll > 8) * (Uma > (17 - UmaAll)) * (Uma - 17 + UmaAll) / 2) + 0.5 * (UmaAll = 17) * (Uma < 17)) - (UmaAll = 18) * (1 + (Uma = 15) + (Uma > 16))
If Waku < 1 Or Waku > 8 Then Waku = 0
If UmaAll < Waku Then Waku = 0
枠カラー
End Sub
Sub 枠カラー()
If Waku = 0 Then MyColor = 1
If Waku = 1 Then MyColor = 2
If Waku = 2 Then MyColor = 16
If Waku = 3 Then MyColor = 3
If Waku = 4 Then MyColor = 5
If Waku = 5 Then MyColor = 6
If Waku = 6 Then MyColor = 50
If Waku = 7 Then MyColor = 46
If Waku = 8 Then MyColor = 38
End Sub
Sub 場カラー()
For X = 2 To 10 Step 4 'Umaを4づつ加算する
For Uma = 1 To 18
YJo = Uma + 3
E = Cells(YJo, X) '複勝回収値
回収色
Cells(YJo, X).Interior.ColorIndex = MyColor
Next
Next
Sub レース計算()
Erase DAll '配列初期化
Erase DSort '配列初期化
Erase DSirusi '配列初期化
'----------------------------------------------------回収率の平均の80%補正値
A = 0
B = 0
For Uma = 1 To 18
If DJk(Uma, 3) = 0 Then '初戦
DJk(Uma, 1) = 80
End If
DAll(Uma, 1) = (DJk(Uma, 1) + DJo(Uma, 1)) / 2
If Oz(Uma) > 0 Then
A = A + DAll(Uma, 1) / Oz(Uma)
B = B + 1 / Oz(Uma)
End If
Next
C = 80 / (A / B) '補正値
'----------------------------------------------------80%補正
For Uma = 1 To 18
DAll(Uma, 1) = DAll(Uma, 1) * C
DSort(Uma, 1) = Uma '馬番
DSort(Uma, 2) = Oz(Uma) 'Ｏｚ
DSort(Uma, 3) = DAll(Uma, 1) '総合
Next
'----------------------------------------------------OZ順に並べ替え
For A = 1 To 18
For B = A + 1 To 18
If DSort(A, 2) > DSort(B, 2) Then
For C = 1 To 3
DSort(0, C) = DSort(A, C)
DSort(A, C) = DSort(B, C)
DSort(B, C) = DSort(0, C)
Next
End If
Next
Next
'----------------------------------------------------印
St1 = "◎〇▲△"
B = 1
For A = 1 To 18
If DSort(A, 2) > 0 Then 'Ozゼロを省く
If DSort(A, 3) > 84 And B < 5 Then '回収率の84％以上の人気順に印
DSirusi(DSort(A, 1)) = Mid(St1, B, 1)
B = B + 1
Else
If DSort(A, 3) > 100 Then
DSirusi(DSort(A, 1)) = "×" '回収率100以上に印
End If
End If
End If
Next
End Sub
Sub レース表示()
Application.ScreenUpdating = False '画面更新停止 して画面更の時間を減らす
'------------------------------------------------------コピペで消える罫線書き
Range(Cells(1, 6), Cells(3, 15)).Select 'セルの範囲を選択 レース条件
Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous '範囲内の横線
Range(Cells(5, 6), Cells(22, 15)).Select 'セルの範囲を選択 総回 出馬表
Selection.Borders.LineStyle = xlContinuous 'セル範囲に矩形の細線が引かれます。
Selection.BorderAround Weight:=xlThin '選択範囲を外枠に細線 !!外枠は2度引いているが、一か所ずつ罫線を引くより処理速度も速くなりる
Selection.Interior.ColorIndex = 2 '選択範囲を指定の色で塗りつぶし
'Selection.Borders(xlInsideVertical).LineStyle = xlContinuous '--範囲内の縦線
'Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous '範囲内の横線
'括弧()を省略すると xlEdgeBottom、xlEdgeLeft、xlEdgeRight、xlEdgeTop、xlInsideHorizontal、xlInsideVerticalこれら全てに設定をしたことになります｡
'Bordersのプロパティ
'プロパティ プロパティの説明 プロパティの設定値 設定値の説明
'LineStyle 罫線の種類 xlNone または xlLineStyleNone なし
'xlContinuous 実線
'xlDash 破線
'xlDashDot 一点鎖線
'xlDashDotDot ニ点鎖線
'xlDot 点線
'xlDouble 2 本線
'xlLineStyleNone 線なし
'xlSlantDashDot 斜破線
'Color 罫線の色 RGB値を表す長整数
'ColorIndex 罫線の色 1～56 2003までの56色カラーパレットのインデックス
'何色か分かりづらいのでColorを使ったほうが良い
'Weight 罫線の太さ xlHairline 非常に細い線 (最も細い罫線)
'xlMedium 普通
'xlThick 太線(最も太い罫線)
'xlThin 細線
'-----------------------------------------------------------
Cells(3, 5) = Cosu & Cells(3, 5)
Cells(4, 3) = Jo & RNo
Cells(4, 4) = RTime
For Uma = 1 To 18
YR = Uma + 4
If Oz(Uma) > 0 Then
Cells(YR, 3) = DSirusi(Uma) '印
If DSirusi(Uma) <> "" Then
Range(Cells(YR, 4), Cells(YR, 15)).Select '印有
Selection.Font.Bold = True '選択範囲をの文字を太く
End If
Cells(YR, 4) = Format(DAll(Uma, 1), "0.0") '総合 Formatで小数点1位に
E = DAll(Uma, 1)
回収色
Cells(YR, 4).Interior.ColorIndex = MyColor
Cells(YR, 5) = Uma '---------馬番
枠変
Cells(YR, 5).Interior.ColorIndex = MyColor
Oz色 '------------------------OZ
Cells(YR, 6).Font.ColorIndex = MyColor '文字の色を指定
Cells(YR, 16) = DJk(Uma, 1) '--騎手
E = DJk(Uma, 1)
回収色
Cells(YR, 16).Interior.ColorIndex = MyColor
Cells(YR, 17) = DJk(Uma, 2)
Cells(YR, 18) = DJk(Uma, 3)
Cells(YR, 19) = DJo(Uma, 1) '--場
E = DJo(Uma, 1)
回収色
Cells(YR, 19).Interior.ColorIndex = MyColor
Cells(YR, 20) = DJo(Uma, 2)
Cells(YR, 21) = DJo(Uma, 3)
Else
'----------------------------------------OZ0未満
Range(Cells(YR, 2), Cells(YR, 21)).Select
Selection.ClearContents
Selection.Interior.ColorIndex = 16
End If
Next
Application.ScreenUpdating = True '画面更新再開
End Sub
Sub レースクリア()
'----------------------------------------
Cells(3, 5) = "" '馬場状態
Range(Cells(1, 5), Cells(3, 13)).Select 'レース条件
Selection.ClearContents '選択範囲をクリア
Range(Cells(4, 3), Cells(4, 4)).Select 'レース 発送時刻
Selection.ClearContents
'----------------------------------------
Range(Cells(5, 2), Cells(22, 21)).Select '出馬表
Selection.Interior.ColorIndex = 2
Selection.Font.Bold = False '選択範囲の文字の太さを標準
Selection.ClearContents
End Sub
お疲れ様でした😎
いいなと思ったら応援しよう！
