趣味のエクセルマクロ

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

マクロ作成方法14(自動記録・検索)

マクロ自動記録で検索します。下の表の様に0666を検索しています。ホームの検索と置換のメニューから検索を選び、オプションで検索対象を値にしています。


記録されたマクロは以下の様になりました。


Sub Macro1()
    Selection.Find(What:="0666", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate
End Sub



自動記録で出来たマクロを元に以下の様に追加修正しています。
検索する番号は文字変数 bango で扱っています。


Sub box_kensaku()
Dim bango As String
  On Error GoTo errorcheck
Sheets("box").Select
  Range("B3:W65").Select
   bango = Application.InputBox("box番号入力して下さい", Default:=Cells(1, 25))
  
   If Len(bango) <> 4 Then MsgBox ("4桁で番号入力してください。"): End
  
   Cells(1, 25) = bango
’---------------------------------------------------------------------------------------------------------------
    Selection.Find(What:=bango, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, MatchByte:=False, SearchFormat:=False).Activate
’---------------------------------------------------------------------------------------------------------------
          retu = ActiveCell.Column
          gyou = ActiveCell.Row
     Range(Cells(gyou, retu + 1), Cells(gyou, retu + 1)).Select
   
       res = MsgBox("集計しますか", vbYesNo)
    If res = vbYes Then
       Cells(gyou, retu + 1) = Cells(gyou, retu + 1) + 1
    
    End If
   box_kensaku_3
   
    Exit Sub
errorcheck:
  MsgBox ("番号がありません。チェックして下さい"): End
End Sub



マクロの自動記録で、どんどんマクロを作って見るのは良いと思います。
記録されたマクロを見てマクロを考えるのは大事だと思います。


・どんな表示になっているか
・一部を変えてマクロを実行したら
・応用するには



マクロ作成方法13(自動記録・コピー)

書式コピーもマクロの自動記録で作ってます。手入力では無理ですねw


指定した行(変数gyou)に5行上の書式をコピー 
自動記録ではコピー元とコピー先がセルの番地なので、マクロ実行でいつも同じ動作になります。そこでコピー元とコピー先を下の様にして変化に対応出来る様にしてます。



  Dim gyou As Integer
     gyou = ActiveCell.Row ’マウスで指定した行数を変数に入れる
  Cells(gyou - 5, 66).Select ’コピー元(指定行の5つ上の行)
    Selection.Copy
    Cells(gyou, 66).Select 
’コピー先
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False


3031の文字色を5行下の5935に書式コピー





計算式コピー


計算式も最初の行に設定しておいて、追加のデータ用に計算式のコピー貼り付けしてます。(間違って消した場合の為に上から5行分くらい計算式はあります)


計算式を値コピーすれば計算式が無くなり数千行の表が軽くなります。
これも自動記録で作成出来ますね。コピー元・先は書式コピーと同様にします。



マクロの自動記録で作成した後、指定部分を変更してマクロの動きを確認します。
もし上手く行かなかったら修正して行きます。


自動記録は変化する行には対応出来ないので問題ですが、手動作成ではマクロ作成ポイントです。





マクロ作成方法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