趣味のエクセルマクロ

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

マクロ作成方法 9(N4復活数字集計)

ナンバーズにおいて復活数字と言う考え方があります。


たとえば


 4884回 9923 当選


 4885回 4445 当選


 4886回 6562 当選   の時に


   4884回の 9923の2、3、9が4885回に出ないで 4886回に2が出ている時


   2が復活数字です(1回休んで出る事)。3,9は復活数字ではないですね。


 
 これを集計するわけですが、どういう考えが必要かですね?


たとえば2回分でカウントを取って判定する。


6562の2の場合、4445と9923で2があるかどうかの判定は出来ると思います。


Sub n4bx_fukkatu_ta()
 Dim xa(7),  ii, i As Integer
 
 Sheets("出現数").Select


  Range("jj5:js5").Select
    Selection.ClearContents
  
    Call saikeisanoff  '再計算等停止
 
    i = 6



Do Until Sheets("ストレートパターン").Cells(i, 3) = ""


    


  For ii = 4 To 7  '番号の4列から7列のデータ処理
  
               xa(ii) = Sheets("ストレートパターン").Cells(i, ii)
   
        If WorksheetFunction.CountIf(Range(Sheets("ストレートパターン").Cells(i - 2, 4), Sheets("ストレートパターン").Cells(i - 2, 7)), _
         xa(ii)) >= 1 Then '前々回に同じ数字があれば
         
        If WorksheetFunction.CountIf(Range(Sheets("ストレートパターン").Cells(i - 1, 4), Sheets("ストレートパターン").Cells(i - 1, 7)), _
         xa(ii)) = 0 Then '前回に同じ数字が無かったら
           
       Cells(5, 270 + xa(ii)) = Cells(5, 270 + xa(ii)) + 1 ’今回の復活集計
    
       End If
   
       End If
      
  Next ii
 
  i = i + 1


 Loop
 
     Range("JJ5:JS5").Select '条件での色付 マクロ自動記録作成
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlAboveAverage
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlBelowAverage
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
 
 
 
     Call saikeisanon  '再計算開始
 
  Cells(1, 270).Select
   Cells(1, 279) = i - 4 & " 回"



End Sub



 

マクロ作成方法 8 (N4ボックス後追い数字集計(重複無))

マクロ作成方法 7 の N4ボックス後追い数字(重複有))を元に考えます。


重複有る部分の判断と、その結果から計算方法を考えれば良いですね。


上の表の様に1~4のパターンが出て来ますが、各パターンでの対応を考えて行きます。


たとえばシングルが出て次もシングルなら4×4で16通りの計算になります。



ダブルからダブルなら重複無で考えたなら3×3で9通りですが、シングルと同じと考えて


16通り計算します。ただし重複部の計算はしないようにします。


(注)同じ番号同志での後追い集計は引っ張り集計にもなります。



(別の考え方もあると思いますが、複雑になりそうなので今回は簡単な方法で)






       <N4ボックス後追い数字集計(重複無)>



4つの数字をカウントして重複の有無を判断し計算するマクロ



Countifを使い前の番号と後の番号の2番目から4番目の数字が重複しているかを調べま


す。 (1番目は重複無なので 1,2 1,2,3 1,2,3,4 下線の番号をチェック )


前の番号、後の番号どちらかまたは両方重複していたら、それに応じた計算にします。



 Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + p の集計で重複無の時Pを1とし、


重複有の時は Pを0とし(mとnから)計算結果に変化が無いようにしています。


(P=m*nで判別 mnとも1で重複無の計算、それ以外は重複有の計算)


 m=1,n=1----重複無の時の条件とする(p=1)。  


 m=1と n=0  、   m=0と n=1  、  m=0とn=0 ------重複有の時の条件とする(p=0)。  




**********************************************************************************************


Sub n4bx_ato_oi_tyonon()  'N4ボックス後追い集計(重複無での計算)


Dim xa, ya, i, ii, iii, m, n, p As Integer


 Sheets("出現数").Select


  Range("ik5:it14").Select
    Selection.ClearContents ’データ出力部のクリア
   
   
    Call saikeisanoff  '再計算等停止  マクロ作成方法  1 と同様


i = 5 ’5行目から


Do Until Sheets("ストレートパターン").Cells(i, 3) = ""


  For ii = 4 To 7  '前の番号の4列から7列のデータ処理
 
          xa = Sheets("ストレートパターン").Cells(i - 1, ii) '前の数字(i - 1)
          m = 1 ’重複無とする(最初の数字は重複は無いので)
         
       If ii >= 5 Then  '5、6、7で同じ数字(重複有)があればmを0とし無ければmを1とする。
         
          If WorksheetFunction.CountIf(Range(Sheets("ストレートパターン").Cells(i - 1, 4), Sheets("ス  ト レートパターン").Cells(i - 1, ii)),  Sheets("ストレートパターン").Cells(i - 1, ii)) = 1 Then
               m = 1 ’重複無とする カウントして1なら
          Else
             m = 0 ’重複有とする カウントして2以上なら
          End If
              
       End If
         
             
     For iii = 4 To 7   '後の番号の4列から7列のデータ処理
       
           ya = Sheets("ストレートパターン").Cells(i, iii)  '後の数字
           n = 1 ’重複無とする(最初の数字なので)
         
        If iii >= 5 Then '5、6、7で同じ数字(重複有)があればnを0とし無ければnを1とする。
         
          If WorksheetFunction.CountIf(Range(Sheets("ストレートパターン").Cells(i, 4), Sheets("ストレートパターン").Cells(i, iii)), Sheets("ストレートパターン").Cells(i, iii)) = 1 Then
             n = 1 ’重複無とする
          Else
             n = 0 ’重複有とする
           
          End If
         
        End If
         
        
          p = m * n 'm,nが1ならpは1、それ以外はpは0 関係表のパターンに対応。
         
          Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + p '重複有(0)無(1)での集計
                  
     Next iii     
        
   Next ii
 
   i = i + 1
  
 Loop
 
 Call saikeisanon  '再計算等をする
       
       Range("ik5:it14").Select '自動記録マクロでik5:it14のセル範囲を条件塗りつぶし
      
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlAboveAverage
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlBelowAverage
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
   
   
   
   Cells(1, 243).Select
   Cells(1, 243) = i - 4 & " 回" ’最終回号表示する
       
 End Sub


**********************************************************************************************




 p = m * n 'm,nが1ならpは1、それ以外はpは0 関係表のパターンに対応。
         
          Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + p '重複有(0)無(1)での集計


            ↓ ↓ ↓ ↓ ↓


または p を使わずに下の様に mとnの関係から


  If m+n=2 Then  Cells(5 + ya, 245 + xa) = Cells(5 + ya, 245 + xa) + 1


でも良いでしょうね。




引っ張り数字(同じ後追い数字)は  Loop の式の後に下の様にしました。


 Loop
 
 For j = 1 To 10 '引っ張り数字集計(後追いの表から23行目に表示する)


       Cells(23, 244 + j) = Cells(4 + j, 244 + j) 


Next j
 


    引っ張り数字の色付はマクロではなくて別途の設定です。


マクロ作成方法 7(N4ボックス後追い数字集計(重複有))

前回の当選番号に対して、次回の当選番号の数字を重複集計します。



    (図1) 関数を使い4桁の当選数字を1桁づつ4つに分ける


   
              ↓  ↓  ↓



  (図2) (図1)の1桁づつ4つのデータからマクロで後追い集計をする。


 (集計は、前1149と後7921の場合 1と1,2,7,9 1と1,2,7,9 4と1,2,7,9 9と1,2,7,9)



(注)同じ番号同志での後追い集計は引っ張り集計にもなります。



マクロの考え方はロト6の後追い数字集計と同じで、前回の1個づつに対してそれぞれ


4個の次回数字を集計します。下記の簡単なマクロで集計してます。




Sub n4bx_allato_oi()  'N4ボックス後追い集計(重複有)


Dim xa, ya, i, ii, iii As Integer


 Sheets("出現数").Select


  Range("Hr5:ia14").Select
    Selection.ClearContents ’データ出力セルのクリア
   
   
    Call saikeisanoff  '再計算等停止   マクロ作成方法  1 と同様


i = 5 ’5行目から開始



Do Until Sheets("ストレートパターン").Cells(i, 3) = ""


  For ii = 4 To 7  '前の番号の4列から7列のデータ処理
 
            xa = Sheets("ストレートパターン").Cells(i - 1, ii) '前の数字(i - 1)最初は図1のD4~G4
             
        For iii = 4 To 7   '後の番号の4列から7列のデータ処理 
        
            ya = Sheets("ストレートパターン").Cells(i, iii)  '後の数字 最初は図1のD5~G5
           
            Cells(5 + ya, 226 + xa) = Cells(5 + ya, 226 + xa) + 1 '集計
                  
        Next iii
      
       
   Next ii
 
 
   i = i + 1
 
 
 Loop
 
 Call saikeisanon  '再計算等をする
       
       Range("HR5:IA14").Select '自動記録マクロでHR5:IA14のセル範囲を条件塗りつぶし
      
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlAboveAverage
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13561798
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.AddAboveAverage
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).AboveBelow = xlBelowAverage
    With Selection.FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
   
   
   
   Cells(1, 224).Select
   Cells(1, 224) = i - 4 & " 回"
       
 End Sub