趣味のエクセルマクロ

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

マクロ作成方法 4 (ナンバーズペア数字集計)


上の様な表にボックス番号でのペア数字の集計をします。




考え方としては、たとえばボックス番号123や1234の場合のペア数字


 ・123はペア数字は 12、13、23になります。


 ・1234は同じように 12,13,14,23,24,34となります。



作成マクロとしては下記の順番になると思います。


・番号を分解する。


・小さい順に並べる。


・ペア数字を設定する。


・ペア数字を集計する。(表に出力も含む)




但し、1123の1ように同じ数字2ヶ以上の時の重複を計算しないようにするには


ペア数字の設定部分のマクロ作成がすこし難しい気がします。


(全部違う数字のシングルの場合は重複無なので問題はないですが?)



・1123はペアは11、12、13、12,、13、23 ですが12、13が重複してます。


 12、13の集計を1回で終わらせるにはどうしたら良いかを考える事ですね。


・2255は22、25、25、25、25、55 で 25 が重複


・3335は33、33、35、33、35、35 で 33、35 が重複


・5555は55、55、55、55、55、55 で 55 だけで重複



以上の事から当選番号のタイプによって細かく条件を設定しなければ重複無のマクロは


作れない気がします。このへんがマクロ作成の難しさかも知れません。


(重複有の場合はペア設定マクロは共通ですから非常に楽だと思います。)







       < N4ボックスペア集計(重複あり)>


Sub n4bx_pea()  'ナンバーズボックスペア集計 (重複あり)
Dim xa, ya, i, j, k, l,deme(4) As Integer


 Sheets("出現数").Select
  Range("gh5:gq14").Select  
    Selection.ClearContents


i = 4
Call saikeisanoff ’再計算等を中止(他のマクロ作成方法と同様)


Do Until Sheets("ストレートパターン").Cells(i, 3) = ""
   Cells(1, 190) = Val(Left(Sheets("ストレートパターン").Cells(i, 3), 1)) ’GH1セルの部分
   Cells(1, 191) = Val(Mid(Sheets("ストレートパターン").Cells(i, 3), 2, 1))
   Cells(1, 192) = Val(Mid(Sheets("ストレートパターン").Cells(i, 3), 3, 1))
   Cells(1, 193) = Val(Right(Sheets("ストレートパターン").Cells(i, 3), 1)) 'GK1セル
  
    Cells(1, 195) = "=small(gh1:gk1, 1)" ’たとえば1234の1の部分 GM1セルの部分
    Cells(1, 196) = "=small(gh1:gk1, 2)" ’たとえば1234の2の部分
    Cells(1, 197) = "=small(gh1:gk1, 3)" ’たとえば1234の3の部分
    Cells(1, 198) = "=small(gh1:gk1, 4)" ’たとえば1234の4の部分 GP1セルの部分
    
 For j = 1 To 4  '4つの数字(出目)を変数に格納する
     deme(j) = Cells(1, 194 + j)
  Next j


   For k = 1 To 3  ’ペア数字をもとに計算出力する 1つ目と2~4目
         xa = deme(1)
         ya = deme(k + 1)
    
          Cells(xa + 5, 190 + ya) = Cells(xa + 5, 190 + ya) + 1
    Next k
   
  For l = 2 To 3 ’ペア数字をもとに計算出力する 2つ目と3~4目
       xa = deme(2)
       ya = deme(l + 1)


         Cells(xa + 5, 190 + ya) = Cells(xa + 5, 190 + ya) + 1
   Next l
  
       xa = deme(3) ’ペア数字をもとに計算出力する 3つ目と4目
       ya = deme(4)
  
     Cells(xa + 5, 190 + ya) = Cells(xa + 5, 190 + ya) + 1


  i = i + 1
Loop


Call saikeisanon ’再計算等を開始


Cells(3, 187) = i - 4 & " 回" ’最終当選回号を表示
Cells(1, 190).Select


End Sub




 Cells(xa + 5, 190 + ya) = Cells(xa + 5, 190 + ya) + 1の共通式をサブマクロに設定するには


変数xaと yaの設定を変えれば良いと思います。





ナンバーズ3のマクロの場合も基本的にはパターンは同じですね。






マクロでの上の計算結果が正しいかどうかを確かめるには?


(マクロの操作を手動操作でするだけですw)



次の操作を手動ですれば良いと思います。


1・当選番号を小さい順に並び替える。


2・ペア数字を全部だす。


3・ペア数字全部を検索または関数で調べる。



マクロ作成方法 3(N3ストレート・ボックス集計)

ナンバーズ4のストレート、ボックス集計マクロをもとにナンバーズ3を作って見ました。


Sheets("すとれ-と").Cells(i, 3) = ""のように他のシートのデータを元に集計しています。


桁数が少ない分、マクロもシンプルになります。







      (十一桁はナンバーズ3のミニに対応)



Sub n3st_count() 'ナンバーズ3のストレート集計 出力部は10×100で計1000セルの表
Dim i, hyaku, jyuuiti As Integer  '整数変数の宣言


 Sheets("ミニ出現数 ").Select ’マクロ処理シート選択(出力先) 
  Range("fd6:iy15").Select ’マクロ処理セル選択
    Selection.ClearContents ’同上セルの初期設定(データを削除)
 
i = 4 ’最初の処理行


Call saikeisanoff ’マクロ処理速度アップの為に再計算等を止める


Do Until Sheets("すとれ-と").Cells(i, 3) = "" ’データ部が無くなる迄下記の処理
 hyaku = Val(Left(Sheets("すとれ-と").Cells(i, 3), 1)) + 6 ’百の出力位置計算
 jyuuiti = Val(Right(Sheets("すとれ-と").Cells(i, 3), 2)) + 160 ’十一の出力位置計算
 Cells(hyaku, jyuuiti) = Cells(hyaku, jyuuiti) + 1 ’上の出力位置で集計する


i = i + 1 ’処理セルを1行づつ増やす(4→5→6→7---最後の行迄)
Loop ’処理を繰り返す


Call saikeisanon ’再計算等をする
Cells(1, 160).Select
End Sub










Sub n3bx_count() 'ボックス集計


Dim i, hyaku, jyuuiti, hyaku_y, jyuuiti_x, x_f As Integer
 Sheets("ミニ出現数 ").Select ’マクロ処理シート選択(出力先) 
    Range("fd24:hf33").Select
    Selection.ClearContents


i = 4


Call saikeisanoff


Do Until Sheets("すとれ-と").Cells(i, 3) = ""
   Cells(1, 160) = Val(Left(Sheets("すとれ-と").Cells(i, 3), 1))
   Cells(1, 161) = Val(Mid(Sheets("すとれ-と").Cells(i, 3), 2, 1))
   Cells(1, 162) = Val(Right(Sheets("すとれ-と").Cells(i, 3), 1))
   
    Cells(1, 164) = "=small(fd1:ff1, 1)"
    Cells(1, 165) = "=small(fd1:ff1,2) & small(fd1:ff1,3)"
  
hyaku_y = Cells(1, 164) ’ボックスにした時の百位
jyuuiti_x = Cells(1, 165)
   
Select Case jyuuiti_x   '十一の部分だけ位置修正


       Case 11 To 19
         x_f = 1
       Case 22 To 29
         x_f = 3
       Case 33 To 39
         x_f = 6
       Case 44 To 49
         x_f = 10
       Case 55 To 59
         x_f = 15
       Case 66 To 69
         x_f = 21
       Case 77 To 79
          x_f = 28
       Case 88 To 89
         x_f = 36
       Case 99
         x_f = 45
       
       Case Else
        x_f = 0
        
End Select


hyaku = hyaku_y + 24 ’24行目から


jyuuiti = jyuuiti_x + 160 - x_f ’160列から - x_fで列修正


Cells(hyaku, jyuuiti) = Cells(hyaku, jyuuiti) + 1


i = i + 1
Loop


Call saikeisanon
Cells(1, 160).Select


End Sub



(注)Call saikeisanoffなどはナンバーズ4の時と共通です。




マクロ処理ではいつも最初のデータから最後の最新データで計算します。


マクロにミスが無ければ出力結果は正解と言えますね。


マクロの結果と、エクセルメニューの検索で合っているか確認すると良いと思います。


集計数の合計が当選回数と同じなら正しいとも言えますね。

マクロ作成方法 2 (N4ボックス集計)

ナンバーズ4のボックス出現集計表を作成します。


(当選番号が2318としたら小さい順に並べて、ボックス番号は1238とします。)



まずは考え方としては、ストレート集計より少し面倒だと言うことです。



処理手順(例) (ストレートと少し違う処理)


1. 当選番号を小さい順に並び変える。


   (1)並び替えるために4つにわける。
      左から1つ目
      左から2つ目
      右から1つ目
      右から2つ目
     
    
   (2)並び替える
      ソートする為、マクロ自動記録使用
      


2. 出力位置計算


      出力位置の補正をする。(例 09の次は11となるので)
      



3. 表とマクロを作成する。


表は上のようにします。10、20、30などの欄は無いですがボックス番号は小さい順に
並び替えたので当然ですね。



  
マクロとしては、いろんなパターンで作れると思いますが?出力結果が同じなら
マクロ作成は人によって違いますが、どれが正解とは言えないでしょうね。


自分にとって分かりやすい作り方が良いと思います。
      
----------------------------------------------------------------------------------------------------------------------



 下のマクロで上の様な表にボックス番号での計算しましたが時間が掛かります。
 ソートとかに時間が掛かるのでしょうね。


 ワークシート関数を使って4つに分けることや、小さい順にするとかしてから計算をし    
 たのが早いかも知れません。


    
Sub n4bx_count() ’N4ボックス番号の集計マクロ


Dim i, sen_hyaku, jyuu_iti, senhyaku, jyuuiti, x_f, y_f  As Integer
 Sheets("出現数").Select
  Range("dp5:fr59").Select ’出力部の値を消す
  Selection.ClearContents


i = 5


Call saikeisanoff ’ストレート集計の時と同様とする
Do Until Cells(i, 2) = ""
   Cells(1, 120) = Val(Left(Cells(i, 2), 1)) '4つに分ける千桁 セルDP1に
   Cells(1, 121) = Val(Mid(Cells(i, 2), 2, 1)) '4つに分ける百桁
   Cells(1, 122) = Val(Mid(Cells(i, 2), 3, 1)) '4つに分ける十桁
   Cells(1, 123) = Val(Right(Cells(i, 2), 1)) '4つに分ける一桁 セルDS1に
 
  With ActiveWorkbook.Worksheets("出現数").Sort  '小さい順にソートする
        .SetRange Range("DP1:DS1") ’4つに分けたセル
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With


sen_hyaku = Val(Str(Cells(1, 120)) & Str(Cells(1, 121))) ’数字→文字→数字にする千百桁
jyuu_iti = Val(Str(Cells(1, 122)) & Str(Cells(1, 123))) ’数字→文字→数字にする十一桁


Select Case jyuu_iti ’表への出力位置補正


       Case 11 To 19 ’ jyuu_itiが11~19の時 x_fを1にする
         x_f = 1
       Case 22 To 29
         x_f = 3
       Case 33 To 39
         x_f = 6
       Case 44 To 49
         x_f = 10
       Case 55 To 59
         x_f = 15
        Case 66 To 69
         x_f = 21
       Case 77 To 79
          x_f = 28
       Case 88 To 89
         x_f = 36
       Case 99
          x_f = 45
       Case Else ’上記以外の時
        x_f = 0
        
End Select


Select Case sen_hyaku ’表への出力位置補正値


       Case 11 To 19
         y_f = 1
       Case 22 To 29
        y_f = 3
       Case 33 To 39
         y_f = 6
        Case 44 To 49
         y_f = 10
       Case 55 To 59
         y_f = 15
       Case 66 To 69
         y_f = 21
       Case 77 To 79
        y_f = 28
       Case 88 To 89
         y_f = 36
       Case 99
        y_f = 45
       Case Else
        y_f = 0
        
End Select


senhyaku = sen_hyaku + 5 - y_f ’位置補正をして千百桁のセル位置を決める
jyuuiti = jyuu_iti + 120 - x_f ’位置補正をして十一桁のセル位置を決める


Cells(senhyaku, jyuuiti) = Cells(senhyaku, jyuuiti) + 1 ’該当セルで累計計算し表に出力


i = i + 1


Loop


Call saikeisanon ’ストレート集計の時と同様とする
Cells(1, 120).Select
End Sub
      



 Val(Str(Cells(1, 120)) & Str(Cells(1, 121)))について 
Strでセルの数字を文字にする。(2つのセル)
&で2つのセルの文字同志を連結し、さらにValでその文字を1つの数字にする。  




-------------------------------------------------------------------------------------------------------    


ワークシート関数small使用の場合


こちらの方が処理速度が少し早くなります。


Sub n4bx_countk()
Dim i, sen_hyaku, jyuu_iti, senhyaku, jyuuiti, x_f, y_f As Integer
 Sheets("出現数").Select


   Range("dp5:fr59").Select
    Selection.ClearContents


i = 5


Call saikeisanoff


Do Until Cells(i, 2) = ""
   Cells(1, 120) = Val(Left(Cells(i, 2), 1))
   Cells(1, 121) = Val(Mid(Cells(i, 2), 2, 1))
   Cells(1, 122) = Val(Mid(Cells(i, 2), 3, 1))
   Cells(1, 123) = Val(Right(Cells(i, 2), 1))
  
    Cells(1, 126) = "=small(dp1:ds1, 1) & small(dp1:ds1, 2)"
    Cells(1, 127) = "=small(dp1:ds1,3) & small(dp1:ds1,4)"
   
  
sen_hyaku = Cells(1, 126)
jyuu_iti = Cells(1, 127)


Select Case jyuu_iti


       Case 11 To 19
         x_f = 1
       Case 22 To 29
         x_f = 3
       Case 33 To 39
         x_f = 6
        
       Case 44 To 49
         x_f = 10
       Case 55 To 59
         x_f = 15
        
       Case 66 To 69
         x_f = 21
       Case 77 To 79
      
         x_f = 28
       Case 88 To 89
         x_f = 36
       Case 99
         x_f = 45
     
       Case Else
        x_f = 0
        
End Select


Select Case sen_hyaku
       Case 11 To 19
         y_f = 1
       Case 22 To 29
        y_f = 3
       Case 33 To 39
         y_f = 6
        
       Case 44 To 49
         y_f = 10
       Case 55 To 59
         y_f = 15
       Case 66 To 69
         y_f = 21
       Case 77 To 79
      
         y_f = 28
       Case 88 To 89
         y_f = 36
       Case 99
         y_f = 45
        
       Case Else
        y_f = 0
        
End Select
 
senhyaku = sen_hyaku + 5 - y_f
jyuuiti = jyuu_iti + 120 - x_f


Cells(senhyaku, jyuuiti) = Cells(senhyaku, jyuuiti) + 1


i = i + 1
Loop


Call saikeisanon
Cells(1, 120).Select


End Sub



出力セルの位置補正が結構面倒な気がします。それも同じことを2回もしてます。


これは、何とか改善の余地があるような気がします。


マクロはデータ全体の集計ですが、直近50回、100回とかで選択処理出来るようになれば
なお良いと思います。マクロは少し複雑になりますが、それを考えることが勉強ですね。