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
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