ロト6 の ホットナンバー
下図のようにホットナンバーを表示してみた。
赤色はすべてホットナンバーとする。
右端はホットナンバー出現数。
ナンバーズのホットナンバー色付けマクロを応用
ボーナス数字を本数字と同じようにして計算、最後に元のボーナス数字表示に戻す。
ホットナンバー出現数等も出力
以上を第1回~最終回まで一括で処理する。
Dim y As Long
Sub hot_no_all_loto6() 'ホットナンバー赤色付け ●〇
Dim gyou As Long, retu As Long, gyoupoint As Long
Dim i As Long, ii As Long, chbno As Long, lastgyou As Long
Dim x As Long, j As Long
Sheets("表 (2)").Select
lastgyou = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lastgyou
chbno = Cells(i, 8)
Cells(i, 9 + chbno) = "●"
Next i
Call saikeisanoff
For x = 10 To 52
y = 2
Do Until Cells(y, 3) = ""
If Cells(y, x) <> "●" Then
Cells(y + 1, x).Select
Else
Cells(y, x).Select
retu = ActiveCell.Column
gyou = ActiveCell.Row
gyoupoint = gyou
If Cells(gyou, retu) = "●" Then
For ii = 1 To 4
Cells(gyou + ii, retu).Select
j = ii
If Cells(gyou + j, retu) = "●" Then Exit For
y = y + 1
Next ii
If Cells(gyou + j, retu) = "●" And WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu)), "●") >= 2 Then
y = y - 2 'データ行チェックの調整
Cells(gyoupoint, retu).Select
Call 入力赤丸
End If
End If
End If
y = y + 1
Loop
Next x
For ii = 2 To lastgyou
chbno = Cells(ii, 8)
Cells(ii, 9 + chbno) = "〇"
Next ii
Call loto6_hot_no_chk
Call saikeisanon
End Sub
Sub 入力赤丸()
Dim maruiti As Object
retu = ActiveCell.Column
gyou = ActiveCell.Row
Set maruiti = Application.Cells(gyou, retu)
jj = 1
If Cells(gyou + jj, retu) <> "●" Then
Do Until Cells(gyou + jj, retu) = "●"
If jj > 3 Then Exit Do
jj = jj + 1
Loop
End If
Cells(gyou + jj, retu).Select
maruiti.Font.Underline = xlUnderlineStyleSingle
maruiti.Font.Color = -16776961
'y = y + jj 'データ行チェックの調整
y = y + jj-1 'データ行チェックの調整(上の式を修正)
If Cells(gyou + jj, retu) <> "●" Then Exit Sub
Call 入力赤丸
End Sub
ホットナンバー出現数等
Sub loto6_hot_no_chk() 'ホットナンバーチェックと数量
Dim retu As Long, gyou As Long
Dim jj As Long, iro As Long, chkretu As Long
Dim hotosuu As Long
Range(Cells(3, 62), Cells(2222, 104)) = 0
Call saikeisanoff
Do Until Cells(2 + jj, 2) = ""
For m = 1 To 7
chkretu = Cells(2 + jj, m + 1)
iro = Cells(2 + jj, chkretu + 9).Font.Color
If iro = 255 Then
Cells(2 + jj, m + 1).Font.Color = 255
Cells(3 + jj, chkretu + 61) = 1 'ホットナンバー集計用
hotsuu = hotsuu + 1
End If
Next m
Cells(2 + jj, 59) = hotsuu
hotsuu = 0
jj = jj + 1
Loop
Call saikeisanon
End Sub
再計算オフ オン 等
Sub saikeisanoff()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = False
Application.ScreenUpdating = False
End Sub
Sub saikeisanon()
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
Application.ScreenUpdating = True
End Sub