趣味のエクセルマクロ&数字選択式宝くじ

ナンバーズ4などの数字選択式宝くじデータ分析用の自作マクロおよびナンバーズ4などの各種データリストなどをブログにしています。

BINGO 5 パターン表 2

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

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


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


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


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



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


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



Public pata As String
Public pata_f As Integer
Public hit(1000, 8) As Integer
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


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


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


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


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


Public pata As String
Public pata_f As Integer
Public hit(1000, 8) As Integer
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

BINGO 5 パターン表 1


上の表の様にビンゴ5パターン表を作って見ましょう。


当選番号に合わせて表にしるしを付けるには関数かマクロでも出来ますね。


関数なら IF関数で当選番号に対応して作っていけば良いです。


当選が3なら表の対応するところに●なら =IF(B4=3,"●","")ですね。


表の対応する番号全部にあらかじめ関数を入れて行けば良いです。



マクロで作るならミニロトなどのマクロを参考にして作っても良いですね。


ユーザーホームで数字か記号かを選択するように考えてましたが?
ユーザーホームの作り方を忘れてましたw


思い出しながら作って見たいです。ミニロトのマクロを確認して行くしかないです。


ホットナンバーも表示出来る様に考えたいですね。


前に書いた「ユーザーホーム」の記事も参考になると思いますが、私は具体的に作り方を書いてないです。ネット上にあるプロの人のサイトをチェックするのが早いですw



ミニロトのマクロを参考にしておなじようにビンゴ5のマクロを作って見ました。
連番は少ないですが?01と40も連番として色付しています。


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


Sub bing5_patn() '当選数字パターン貼付け
Call saikeisanoff


Erase hit: pata_f = 0: pata = "" 'Public変数の初期化
 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 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



ユーザーホームのマクロは下の様にしました。


オプションボタン1、2で数字かを選択するマクロ


コマンドボタンのマクロ名は下記の様に 中止する 実行する に書き換えてます。
(書き換えなくてもOKです) 


オプションボタンをマウスでクリック後、右クリックし「コードの表示」選択後にコードを下記の様に修正します。




再計算を止めると再計算するマクロ


再計算を止めた後は計算式のため再計算するに戻します。
                 
    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



再計算関係マクロを色んな場所で使うなら
Public Sub saikeisanoff()    Public Sub saikeisanon()とした方が本当は良いですね。


マクロ学習法とは 12(定数)

変数は値が変化しますが、変化しないのが定数です。と言うか値は自分で決めます。


Excelマクロ・VBA塾さんのサイトに2種類があると書いてました。


次に下記の記述がありました。


ユーザー定義定数は組み込み定数のように用意されているものではなく、「自分自身で作った定数」のことをいいます。定数を定義するためには「Const」を使って宣言する必要があります。


定数の宣言には2つの方法があります。


Const 変数名 = 値


Const 変数名 As 型 = 値 
   
定数を定義するということは指定した数値や文字列など値に名前を付けて、マクロ作成の中で一度定義したら絶対に変更がきかないようにすることです。



私のマクロで定数を試して見ました。


Sub n4s_topen()
    Workbooks.Open Filename:="C:\Users\km\Desktop\NUMBERS 関 連\NO.4ST分析.xlsm"
          Windows("No.4予測パターン抽出.xlsm").Activate
    ActiveWindow.Close
End Sub



上の 他のファイルを開くマクロ は 定数を使って下の様に書き直すことが出来ます。


Sub n4s_topen()
    Const fromfile = "C:\Users\km\Desktop\NUMBERS 関 連\NO.4ST分析.xlsm"
    Workbooks.Open Filename:=fromfile
          Windows("No.4予測パターン抽出.xlsm").Activate
    ActiveWindow.Close
End Sub



モジュールの先頭で宣言すれば、そのモジュールの色んなプロシジャー(マクロ)で使えるようです。 Public Const もあるようですが全体で使える定数ですね。


定数を使えば、定数を直すことで定数使用中の全部のマクロを直したことになります。