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

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

BINGO 5 パターン表 2

記事目次　ロト・ビンゴ 



ホットナンバー赤色表示マクロ

赤色でホットナンバーも表示して見ました。（ビンゴ5は同じ番号が出る傾向が強い）


＜＜　ホットナンバーは出現間隔が3以下で最低3回以上出現した時としています。＞＞
（確率上間隔2回以下が良いかも知れません、その場合はマクロを修正します）


数字を表示させる時にはホットナンバーマクロは動きませんが、●で表示させた後なら
数字も赤色の書式のままで表示されます。


マクロはパターン表1のマクロに今回はホットナンバー表示マクロを追加しました。


BINGO 5 パターン表 1


ユーザーホームは変更なしです。（パターン表1を参照してください）


おかしいところもありますが、順次修正予定です。



Public pata As String
Public pata_f As long
Public hit(1000, 8) As long
Dim colohani As Object
----------------------------------------
Sub bing5_patn() '当選数字ﾊﾟﾀｰﾝ貼付け
saikeisanoff


Erase hit: pata_f = 0: pata = ""
 UserForm1.Show 'ﾕｰｻﾞｰﾎｰﾑを開く
    i = 4
Do Until Cells(i, 2) = ""
    For j = 1 To 8
        hit(i - 3, j) = Cells(i, j + 1)
    Next j
  
    If i = 300 Then Exit Do
     i = i + 1
    k = i
Loop


   For i = 1 To k - 4
        For j = 1 To 8
         If pata_f = 1 Then
                     
             Cells(i + 3, 10 + hit(i, j)) = hit(i, j)
          Else
                 
            Cells(i + 3, 10 + hit(i, j)) = pata
          End If
      
        Next j
    Next i
    Call renpata
    Call bingo5_hotno　’ホットナンバー赤色付
    saikeisanon
End Sub


--------------------
Sub renpata() '連番数字
i = 4
Do Until Cells(i, 2) = ""
    For k = 1 To 7
      
    If hit(i - 3, k) - hit(i - 3, k + 1) = -1 Then
         karaiti = Cells(i, k + 1) + 10
    Set colohan = Application.Union(Range(Cells(i, k + 1), Cells(i, k + 2)), Range(Cells(i, karaiti), Cells(i, karaiti + 1)))
       colohan.Interior.ColorIndex = 35
    End If
  Next k
    
     If hit(i - 3, 1) = 1 And hit(i - 3, 8) = 40 Then
        Set colohani = Application.Union(Cells(i, 2), Cells(i, 9), Cells(i, 11), Cells(i, 50))
       colohani.Interior.ColorIndex = 35
     End If
               
      If i = 1000 Then Exit Do
      i = i + 1
  Loop
  Range(Cells(i, k), Cells(i, k + 1)).Select
End Sub


--------------------------
Sub bingo5_hotno()　’ホットナンバー赤色付　（追加分）


For y = 11 To 51
i = 4
Do Until Cells(i, 2) = ""
If Cells(i, y) = "" Then
   Cells(i + 1, y).Select
 Else
    Cells(i, y).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
     Next ii
     
        If Cells(gyou + j, retu) = "●" And WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu)), "●") >= 2 Then
       
         Cells(gyoupoint, retu).Select
         入力赤丸
        End If
    End If
  End If
      i = i + 1
   Loop
 Next y
End Sub


------------------------ 
 Sub 入力赤丸()
Dim maruiti As Object
   retu = ActiveCell.Column
    gyou = ActiveCell.Row
   
 Set maruiti = Application.Cells(gyou, retu)
  Cells(gyou + 1, retu).Select
          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
   
   If Cells(gyou + jj, retu) <> "●" Then Exit Sub
　入力赤丸
 End Sub
-----------------------------------------------------------------------------------
-----------------------------------------------------------------------------------
マクロのスピードアップ
  Sub saikeisanoff()
    With Application
            .Calculation = xlManual
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = False
    End Sub


------------------------------
    Sub saikeisanon()
     With Application
            .Calculation = xlAutomatic
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = True
    End Sub


ホットナンバーの間隔2以下とした場合、マクロ修正します。
あらかじめ変化させる部分を定数にしたのが良いかも知れませんが？


Sub bingo5_hotno()
For y = 11 To 51
i = 4
Do Until Cells(i, 2) = ""


If Cells(i, y) = "" Then
   Cells(i + 1, y).Select
Else
    Cells(i, y).Select
    retu = ActiveCell.Column
     gyou = ActiveCell.Row
     gyoupoint = gyou


    If Cells(gyou, retu) = "●" Then
   
      For ii = 1 To 3
           Cells(gyou + ii, retu).Select
       j = ii
       If Cells(gyou + j, retu) = "●" Then Exit For
    Next ii
      If Cells(gyou + j, retu) = "●" And WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 3, retu)), "●") >= 2 Then
   
         Cells(gyoupoint, retu).Select
         入力赤丸
　　End If
    End If
  End If
   
    i = i + 1
  Loop


 Next y
End Sub


 -----------------
 Sub 入力赤丸()
Dim maruiti As Object
   retu = ActiveCell.Column
    gyou = ActiveCell.Row


 Set maruiti = Application.Cells(gyou, retu)
  Cells(gyou + 1, retu).Select
 
         jj = 1
   If Cells(gyou + jj, retu) <> "●" Then
      
     Do Until Cells(gyou + jj, retu) = "●"
    
      If jj > 2 Then Exit Do
     jj = jj + 1
    Loop
   
  End If
    Cells(gyou + jj, retu).Select
    maruiti.Font.Underline = xlUnderlineStyleSingle
    maruiti.Font.Color = -16776961
   
   If Cells(gyou + jj, retu) <> "●" Then Exit Sub
入力赤丸
End Sub


ホットナンバー色付マクロの動きをよく見たらマクロにおかしいところがありました。
マクロの中から他のマクロを呼び出しているので矛盾があるのかも知れません？


データを上から下に向かって調べて行きますがマクロでの動きがダブっています。
だから行を戻ったりします。処理が終わった時点で位置の調整をするようにしたいです。
目的は果たしてますが、無駄な動きをしていますね。


無駄な動きをしないようにマクロを変えてみました。データ行のチェックの調整です
（今後、問題がないかテストを繰り返して行く予定）


変数の再設定（プロシジャーレベルからモジュールレベルに変更）
変数ｙ（モジュールレベル変数に）と変数ｘの追加（ｙをｘに変更）
変数ｙでデータ行チェックの調整をする。


Public pata As String
Public pata_f As long
Public hit(1000, 8) As long
Dim colohani As Object


Dim y As Integer　’プロシジャーレベル変数に
---------------------------------------------------------
Sub bing5_patn() '当選数字ﾊﾟﾀｰﾝ貼付け
saikeisanoff


Erase hit: pata_f = 0: pata = ""
 UserForm1.Show 'ﾕｰｻﾞｰﾎｰﾑを開く


    i = 4
Do Until Cells(i, 2) = ""
    For j = 1 To 8
        hit(i - 3, j) = Cells(i, j + 1)
    Next j
  
    If i = 300 Then Exit Do
     i = i + 1
    k = i
Loop


   For i = 1 To k - 4
        For j = 1 To 8
         If pata_f = 1 Then
              
             Cells(i + 3, 10 + hit(i, j)) = hit(i, j)
          Else
            Cells(i + 3, 10 + hit(i, j)) = pata
        
          End If
         Next j
    Next i


   Call renpata
   Call bingo5_hotno
    saikeisanon
End Sub
-------------------------------
Sub renpata() '連番数字
i = 4
Do Until Cells(i, 2) = ""
    For k = 1 To 7
　   If hit(i - 3, k) - hit(i - 3, k + 1) = -1 Then
         karaiti = Cells(i, k + 1) + 10
    Set colohan = Application.Union(Range(Cells(i, k + 1), Cells(i, k + 2)), Range(Cells(i, karaiti), Cells(i, karaiti + 1)))
           colohan.Interior.ColorIndex = 35
  
 　   End If
    Next k
   
      If hit(i - 3, 1) = 1 And hit(i - 3, 8) = 40 Then
         Set colohani = Application.Union(Cells(i, 2), Cells(i, 9), Cells(i, 11), Cells(i, 50))
       colohani.Interior.ColorIndex = 35
      End If
               
    If i = 1000 Then Exit Do
     i = i + 1
  
Loop
 Range(Cells(i, k), Cells(i, k + 1)).Select
End Sub


 ---------------------------------               
    Sub saikeisanoff()
    With Application
            .Calculation = xlManual
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = False
               
    End Sub
---------------------------------
    Sub saikeisanon()
     With Application
            .Calculation = xlAutomatic
            .MaxChange = 0.001
        End With
        ActiveWorkbook.PrecisionAsDisplayed = True
    End Sub
------------------------------
Sub bingo5_hotno()　’ホットナンバー部のチェックをする


For x = 11 To 50
y = 4
Do Until Cells(y, 2) = ""
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 3
         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 + 3, retu)), "●") >= 2 Then
       
          y = y - 2 'データ行ﾁｪｯｸの調整
       
         Cells(gyoupoint, retu).Select
         入力赤丸　’ホットナンバー部を赤色等にするマクロ
        End If
    End If
  End If
       y = y + 1
  Loop
 Next x
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 > 2 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 'データ行ﾁｪｯｸの調整
   
  If Cells(gyou + jj, retu) <> "●" Then Exit Sub
　入力赤丸
  End Sub