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

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

マクロ学習法とは 8(続・関数)

マクロの中で通常の関数を使って集計します。
10行おきに集計場所が変化しますので、10行おきに関数を変化させなければなりません。
とりあえず10行作成します。(出目0~9の10個の出現集計させる)


上の様にy列5003行には一番上の計算式=COUNTIF($E$5003:$G$5012,X5003)
1行下の5004行は=COUNTIF($E$5003:$G$5012,X5004)となってる。
10行分の範囲はセルの絶対座標($E$5003:$G$5012)で同じにしています。


10行下のy列5013行には一番下の計算式で計算範囲などは10行分変わってきます。
マクロ実行して =COUNTIF($E$5013:$G$5022,X5013)となってる。




y列5013行でマクロ実行します。(x列5013行に出目0が入って無ければ実行しません)


  Sub 間隔計算式入力()
Dim gyou, retu As Integer
 Worksheets("原本").Select
gyou = ActiveCell.Row  '選択セルの行
retu = ActiveCell.Column '選択セルの列


If retu <> 25 Then End ’y列以外は実行出来ない y列に計算式を作成するため


 Cells(gyou, retu).Select


 If Cells(gyou, retu - 1) = 0 Then ’x列5013行に0が入っていれば実行
’計算式は変数gyouを元に下の式で作成 =COUNTIF($E$5013:$G$5022,X5013)になる
   Cells(gyou, retu) = "=COUNTIF($E$" & gyou & ":$G$" & gyou + 9 & ",X" & gyou & ")"


 End If
’9行分下にコピー貼り付け、最後の行は =COUNTIF($E$5013:$G$5022,X5022)になる


     Selection.Copy
    Range(Cells(gyou, retu), Cells(gyou + 9, retu)).Select ’10行分に計算式貼り付け
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
       
End Sub


もしセルの計算式を値コピーして消していても、再度マクロ実行で計算式が出来ます。


10行単位で連続して計算式を入力する場合はマクロを改良する必要が有りますが?
その場合は10行おきにマクロを実行するようにします。





以前は前行の式を下にコピーして下のマクロで計算式を置換してました。
(計算式が残っていないとマクロ実行出来ず。)


  Sub 間隔計算式__置換()   '計算式置換コピーテストWhat:="4302", Replacement:="4312"
' Cells.Find(What:="4302",e What:="4311", Replacement:="4321" Cells.Find(What:="4311"

Dim gyou, retu As Integer
 Worksheets("原本").Select


gyou = ActiveCell.Row
retu = ActiveCell.Column


If retu <> 25 Then End


a_gyou = gyou - 10
b_gyou = gyou - 1
c_gyou = gyou + 9


 Cells(gyou, retu).Select


  ActiveCell.Replace What:=a_gyou, Replacement:=gyou, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      
    ActiveCell.Replace What:=b_gyou, Replacement:=c_gyou, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    
   Selection.Copy
    Range(Cells(gyou, retu), Cells(gyou + 9, retu)).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
       
End Sub


昔は手入力してましたが、座標確認等で凄く面倒でした。やはりマクロは便利ですね!

mini loto で当てよう loto 6

ロト6でもミニロト状態で当選番号になることがあります。


1312回の抽選で157回と割合は少ないですが?


43個から6個より31個の中から6個を選べたら良いですね?


(この表にも入力ミスがあるかも知れませんので、もし参考にして使うときはみずほ銀行の当選番号案内で確認してください)



ミニロト状態の出現グラフで見ると、短い間隔で続けて出る時も結構ありますね!
平均したら8回強に1回出る確率でした。




出現間隔別では少ない間隔で出るようです。(1~6回が多い?4回が累計20回)





出目の出現状況は上の様なグラフですが極端な出方では無いような気がします。


1319 回は

09 10 19 21 28 30 ボーナス数字43

でミニロト状態出現で1等は該当無しでした。ウ~ンw

マクロ学習法とは 7 (条件分析)

マクロを作る際、条件がハッキリしてないと中々先に進めないと思います。
そこで、自分が知りたい条件の分析が必要になるような気がします。


条件を分析して、分かった色々な事を元にマクロ作成しますが、条件をどうやってマクロ化するか難しいこともありますね。


人間の目で見て判断するのは簡単でも、コンピュータに判断させるのは簡単では無いです。だから出来るだけ条件を単純化させてマクロを作る必要があると思います。


どんなマクロを作るかも経験が必要ですが、その前にどんな事をさせるかを考えられればなんとかマクロは出来ると思います。


条件をすべて明確にして、条件が成立出来る様な考え方をもとにマクロ作成のヒントにするのが良いかも知れませんね。


ここでの数字は123どうしの間隔3としますが、マクロの計算上は4になる。


上の表で赤丸の部分を判断する条件は(元々は黒丸です)
(1)赤丸と赤丸の間隔3以下で
(2)(1)の条件を満たし、赤丸が最低3個以上あること


この2つの条件を頭に入れて、目で見て判断するのは簡単ですが?


マクロを作って、マクロで判断させ、マクロで赤丸にするのは簡単では無いような気がします。(特に、私の場合ですがw)


取りあえず試行錯誤してマクロが出来れば良いなと思ってます。



考え方のひとつは、3個の間隔がすべて3以下と言う事は1個目と2個目の間を for next で計算して3以下なら、計算して分かった2個目の位置と3個目の間3以下での個数を計算するためにcountifで個数を計算します。2個以上なら赤丸にしても良いとします。


1231231212●●123等で条件成立 
123123412341231234等で条件不成立 




1個目と2個目の間隔をcountifで計算する場合も for next を使うので、countifを使わなくても良いと思います。2個目と3個目は定義する間隔にあるなら、位置が分からなくても良いのでcountifで2個目と3個目で最大間隔3で2個以上かを確認するだけですね。



上の考え方で判定マクロで出来れば、そして条件が成立したなら?


下のマクロで赤丸にしても良いと思います。



(今は目で見て判断し下の「入力赤丸」マクロで赤丸にしています)


 Sub 入力赤丸() ’黒丸を赤丸にする(下線も引く)
 Dim maruiti As Object
 Sheets("ストレートパターン").Select
   retu = ActiveCell.Column
    gyou = ActiveCell.Row
    
 Set maruiti = Application.Cells(gyou, retu)
  Cells(gyou + 1, retu).Select
 
         j = 1
   If Cells(gyou + j, retu) <> "●" Then
      
     Do Until Cells(gyou + j, retu) = "●"
    
       If j > 3 Then Exit Do ’間隔4以上は中止
       j = j + 1
    Loop
   
  End If
    Cells(gyou + j, retu).Select
    maruiti.Font.Underline = xlUnderlineStyleSingle
    maruiti.Font.Color = -16776961
   
  If Cells(gyou + j, retu) <> "●" Then ’●が無くなったらマクロ終了させる
   End
  Else
       入力赤丸 ’2個目以上も入力赤丸マクロを再度実行
     End If
End Sub



完全では無いですが、取りあえず下の判定マクロを作って見ました。
(上手く動く自信は有りませんが、ミスが出れば修正出来ればですね)


 Sub ホットナンバーchk() ’間隔が3以下で個数が3個以上なら赤丸にするマクロ
 
  Sheets("ストレートパターン").Select ’シート「ストレートパターン」で動作させる
    retu = ActiveCell.Column
    gyou = ActiveCell.Row
    gyoupoint = gyou ’最初の行とする
   
    If Cells(gyou - 1, retu) >= 4 And Cells(gyou, retu) = "●" Then


          For i = 1 To 4 ’2個目の間隔を調べる。
               Cells(gyou + i, retu).Select
          j = i
         If Cells(gyou + j, retu) = "●" Then Exit For ’1個と2個の間をチェック
      
       Next i
           
  If WorksheetFunction.CountIf(Range(Cells(gyou + j, retu), Cells(gyou + j + 4, retu)), "●")    
 >= 2 Then ’2個と3個の間をチェック
             Cells(gyoupoint, retu).Select
          入力赤丸 ’条件があえば 上の入力赤丸マクロを実行する。 
     Else
             End ’条件が合わなければ、このまま終了する。
     End If
 End If
End Sub


-------------------------------------------------------
  If Cells(gyou - 1, retu) >= 4 And Cells(gyou, retu) = "●" Then は
 If Cells(gyou, retu) = "●" Then だけでも良いような気がします。


2個と3個の間を1個と2個のように for next で計算しても良いです。その場合は式が少し長くなると思います。