趣味のエクセルで当てよう!ロト・ナンバーズ

当選狙いで、ナンバーズ4をメインにロト、ビンゴ5などの各種データリストや、それらの分析用エクセルVBAなどについて書いてます。

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