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

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

マクロ作成方法12(マクロ自動記録)

マクロが自動で記録できるのは便利ですね!
下の様に両脇の罫線を赤色、下線を赤色点線や実線にするマクロを自動記録して見ました。(点線は元々点線なので赤色にします)


Sub Macro1() ’マクロ1 セルBN4933の両側と下を赤色にする自動記録マクロ
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft) ’セルの左の部分です
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop) ’セルの上の部分です
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom) ’セルの下の部分です
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight) ’セルの右の部分です
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub


Sub Macro2() ’マクロ2 セルBN4935の両側と下(実線にする)を赤色にする自動記録マクロ
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThin
    End With


    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -16776961
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
 上の自動記録から必要な部分をさがし、マクロ作成方法11のストレート回数表示5回目と6回目の表示を下の様に改良しました。(最高6回なので7回目は作って無いですw)
私は必要な部分かどうかは試行錯誤しています。w



   caler = WorksheetFunction.CountIf(Range(Cells(2, 66), Cells(i, 66)), Cells(i, 66))
   
              Set stcolo = Cells(i, 66)
            stcolo.Borders(xlEdgeLeft).ColorIndex = 1
          If caler = 2 Then 'ストレート2回目緑色にする
                      stcolo.Borders(xlEdgeLeft).ColorIndex = 4


          ElseIf caler = 3 Then 'ストレート3回目赤色にする
                    stcolo.Borders(xlEdgeLeft).ColorIndex = 3
          
          ElseIf caler = 4 Then 'ストレート4回目両脇赤色にする
        
             stcolo.Borders(xlEdgeLeft).ColorIndex = 3
             stcolo.Borders(xlEdgeRight).ColorIndex = 3
         
          ElseIf caler = 5 Then 'ストレート5回目両脇赤色下線赤色にする
            
             stcolo.Borders(xlEdgeLeft).ColorIndex = 3
             stcolo.Borders(xlEdgeRight).ColorIndex = 3
             stcolo.Borders((xlEdgeBottom)).ColorIndex = 3
            
          ElseIf caler = 6 Then 'ストレート6回目両脇と下線赤色実線にする
             stcolo.Borders(xlEdgeLeft).ColorIndex = 3
             stcolo.Borders(xlEdgeRight).ColorIndex = 3
             stcolo.Borders((xlEdgeBottom)).ColorIndex = 3
             stcolo.Borders((xlEdgeBottom)).Weight = xlThin
          
      
          End If


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

マクロを作って使っていくうちに、色々と問題が出て来たり、アイデアが浮かんで来たりします。そうなった場合はバージョンアップを考える時です。誰でも最初から完璧は無理で試行錯誤すると思います。私の結構多い問題はナンバーズなどの日々増えるデータに対して良く考えて無いで適当にマクロを作り、ある日突然エラーが出てくることですね。(良く考えたら分かるので、偶然でなくて必然W)



例えば問題として出力先のセルの行範囲を適当に決めていて、ある日行範囲を超えて他のデータに干渉してしまい間違った答えになるとかします。解決策としては余裕を持ったセルの確保をするしか無いと思います。この辺はマクロの問題と言うより、使い方を良く考えることですから、シート設計の問題ですね。
(マクロは命令通りに動くだけですw もし空行でなければメッセージ出すとかは?)



下の表のようにマクロで当選番号がストレート2回目の時に当選番号の左の線は緑、3回目は左は赤、4回目以上は左右とも赤にしていたが6回まであった! 当然5回目以降と4回目は表示が同じで6回も出たことを何年も気が付かなかった。このへんは中々難しい問題ですね。気が付かなければ解決策も浮かびませんからw
5回6回も処理したいなら下のマクロに追加する必要がありましたw 7回なら?


       caler = WorksheetFunction.CountIf(Range(Cells(2, 66), Cells(i, 66)), Cells(i, 66))
                  Set stcolo = Cells(i, 66)
                        stcolo.Borders(xlEdgeLeft).ColorIndex = 1
          If caler = 2 Then 'ストレート2回目緑色にする
                         stcolo.Borders(xlEdgeLeft).ColorIndex = 4
          ElseIf caler = 3 Then 'ストレート3回目赤色にする
                         stcolo.Borders(xlEdgeLeft).ColorIndex = 3
          ElseIf caler >= 4 Then 'ストレート4回目以上両脇赤色にする
                      stcolo.Borders(xlEdgeLeft).ColorIndex = 3
                      stcolo.Borders(xlEdgeRight).ColorIndex = 3
          End If



作成したマクロを使っていても、更に使いやすいマクロにすれば時間短縮など作業がもっと楽になります。こうすれば楽になるなとアイデアを考えて行くのも大事なことですね。


勿論マクロの改造作業が必要になりますが、面倒でも改造出来ればマクロ作成スキルアップに繋がると思います。







マクロ作成方法10(詳細集計)

各集計をもっと細かく集計したい時があります。
その時は、間隔を指定するとかが必要になりますね。


間隔を指定する対話型マクロが必要になりますが?その際は最後の行が分かる様に計算式を使って行きます。(下の様にしてますがこの式では5000行迄対応してます。)


集計方法としては次の様なことが考えられます。
(1)一定の間隔毎
(2)直近の任意の間隔(最後のデータから遡って)
(3)最初と最後を任意に指定


 (2)直近の任意の間隔(最後のデータから遡って)の場合はちょっと面倒な気が
 します。別のマクロ作成が必要かも知れないですね。 


直近の回数を入力してペア数字集計するマクロ(最終回からさかのぼって直近50回

(マクロ作成方法6を改造し入力して計算する)
Sub n4bx_pea_tyo_non_nkai() 'ボックスペア集計 (重複なし) 任意の回数での集計
Dim xa, ya, i, j, k, l, m, n, dpt1, dpt2, dpt3, dpt4, dptn, deme(4), ptn, lastkai, skai As Integer
 Sheets("出現数").Select
  Range("HB5:HK14").Select
    Selection.ClearContents


lastkai = Sheets("ストレートパターン").Cells(2, 15) + 3 ’データの集計最終行
skai = InputBox("直近何回分") - 1 '質問で任意の集計回数を入れる(ここで50)


If skai = 0 Or skai > lastkai Then End ’入力制限
i = lastkai - skai
'i = 4
Call saikeisanoff


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


   Cells(1, 210) = Val(Left(Sheets("ストレートパターン").Cells(i, 3), 1))
   Cells(1, 211) = Val(Mid(Sheets("ストレートパターン").Cells(i, 3), 2, 1))
   Cells(1, 212) = Val(Mid(Sheets("ストレートパターン").Cells(i, 3), 3, 1))
   Cells(1, 213) = Val(Right(Sheets("ストレートパターン").Cells(i, 3), 1))
  
    Cells(1, 215) = "=small(hb1:he1, 1)"
    Cells(1, 216) = "=small(hb1:he1, 2)"
    Cells(1, 217) = "=small(hb1:he1, 3)"
    Cells(1, 218) = "=small(hb1:he1, 4)"
   
    Cells(1, 205) = "=countif(hg1:hj1, hg1)" '出目の数を計算
    Cells(1, 206) = "=countif(hg1:hj1, hh1)" '出目の数を計算
    Cells(1, 207) = "=countif(hg1:hj1, hi1)"
    Cells(1, 208) = "=countif(hg1:hj1, hj1)"
  
    dptn = Cells(1, 205) & Cells(1, 206) & Cells(1, 207) & Cells(1, 208)
     Cells(1, 221) = dptn
    
 For j = 1 To 4
     deme(j) = Cells(1, 214 + j)
  Next j
        '全パターンの関係式
            xa = deme(1)
            ya = deme(2)
           Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
 
    Select Case dptn  '各パターンからの計算
  
    Case 1111  'シングル1234  1111
   
      For k = 1 To 2  '出目13,14
  
        xa = deme(1)
        ya = deme(k + 2)
     
      Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
  
       Next k
   
      For l = 2 To 3  '出目23,24
  
        xa = deme(2)
        ya = deme(l + 1)


         Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
  
      Next l
  
         xa = deme(3)  '出目34
         ya = deme(4)
  
         Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
      Case 2211    'ダブル1123  2211
      
         For k = 3 To 4  '出目13,14
          xa = deme(1)
          ya = deme(k)
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
         Next k
      
           xa = deme(3)  '出目23
           ya = deme(4)
  
           Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
     
    Case 1221 'ダブル1223  1221
   
       xa = deme(1)
       ya = deme(4)
  
       Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
   
        For k = 3 To 4 '出目23,24
  
          xa = deme(2)
          ya = deme(k)
     
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
  
       Next k
   
    Case 1122  'ダブル1233   1122
     
        xa = deme(1)
        ya = deme(3)
  
       Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
       
        For l = 1 To 2  '出目23,34
             xa = deme(l + 1)
             ya = deme(l + 2)
     
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
        
        Next l
        
    Case 2222 'ダブルダブル1122  2222
    
         For k = 1 To 2  '出目23 34
      
             xa = deme(k + 1)
             ya = deme(k + 2)
     
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
  
         Next k
      
     Case 1333  'トリプル1 1112 3331
          xa = deme(3)
          ya = deme(4)
     
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1
        
    Case 3331 'トリプル2 1222 1333
   
          xa = deme(3)
          ya = deme(4)
     
          Cells(xa + 5, 210 + ya) = Cells(xa + 5, 210 + ya) + 1


   End Select


i = i + 1


Loop


Call saikeisanon


Cells(3, 210) = " 直近" & skai + 1 & "回分"
Cells(1, 210).Select


End Sub