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

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

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

マクロ学習法とは 5(関数) 


マクロの中で通常の関数を使って集計します。
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 long
 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行おきにマクロを実行するようにします。



マクロ作成方法11(バージョンアップ)


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


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

Dim gyou, retu As long
 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


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