趣味のエクセルマクロ

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

ツールマクロ

私はマクロの自動記録で数行のマクロを結構作ります。もっと少し複雑なマクロをシステムマクロとすれば、自動記録の簡単なマクロ等はツールマクロと言う人もいますね。
ちょっと便利な道具として、あるいはマクロの初歩的な勉強には良いですね。



たとえば下のようなシート間の移動はツールマクロでしょうね。


シート「23桁」に移動するマクロ(シート「欠け算並び」からシート「23桁」に移動)



もし、シートが10枚以上あるとしたなら結構便利だと思います。



マクロの自動記録でシートを選択するだけで下記のようなマクロが出来ます。
( Sheets("シート名").Select が自動記録されます )
自動記録のマクロ名は分かりやすいように後から変更しています。


Sub n23桁へ() ’マクロ名は変更します。シート「23桁」に移動
  Sheets("23桁").Select
End Sub



Sub 順位裏復活へ() ’マクロ名は変更します。
  Sheets("順位裏復活").Select
End Sub


Sub パターン表へ() ’マクロ名は変更します。
  Sheets("パターン表").Select
End Sub





・何回も同じ罫線を引くとかにも使用しています。

Sub keisen_変更() 


Dim gyou As Integer
 gyou = ActiveCell.Row ’現在の指定行(行を選択後にマクロ実行します)


  Range(Cells(gyou, 1), Cells(gyou + 1, 28)).Select ’処理部の範囲指定1~28列
'下からは自動記録部分(見れば、何となく意味は分かると思います)
     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    ’この上まで自動記録
    Cells(gyou + 2, 1).Select ’行の移動 2行下に移動してセルを選択
End Sub


自動記録マクロの1部の式を消したりしたらどうなるかなど調べると、色々勉強になります。自動記録では処理的には必要ない余計な事も記録されます。


上のSub keisen_変更() では以下の部分は必要無いようです。
      .ColorIndex = 0
         .TintAndShade = 0






Sub 太字() 'マウスでクリックしたセルの値を太字にする(複数セルも可)
 Dim hanni As Range
      Set hanni = Selection ’複数セルの設定
     Selection.Font.Bold = True ’自動記録部分
End Sub


複数セルの時、はなれたセルもCtrlキー押しながら選択後 マクロ実行でOKです。







Sub 書式コピー() ’A1の書式をB1にコピー


Dim  copymoto, copysaki As String


     copymoto = InputBox("書式コピー元は") ’セル番地入力する A1
         Range(copymoto).Select
      Selection.Copy
  
    copysaki = InputBox("書式コピー先は") ’セル番地入力する B1
    Range(copysaki).Select


 ’自動記録部分
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False


End Sub




Sub 書式コピー() ’コピー前のセルはマウスでクリック後マクロ実行


Dim copysaki As String
Dim gyou, retu, i As Integer


 gyou = ActiveCell.Row ’マウスでクリックした行
 retu = ActiveCell.Column ’マウスでクリックした列
     
     Cells(gyou, retu).Select
           Selection.Copy
   
    copysaki = InputBox("書式コピー先は")
       
    Range(copysaki).Select


    ’自動記録部分
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub


コピー元はマウスでクリックして指定する場合は行、列を変数にしてマクロ処理の場合は
Cells(gyou, retu).Selectにして、 copymoto 関係式はいらないですね。


コピー先が複数セルの場合は(例)C1:F3 や  C1:F3,H1:K3 や  C1,D2,E3 等と指定





・書式コピーで良く使ってるのは(同じ列限定で上のセルの書式を下のセルにコピー)


Sub syosikicopy()  '同じ列で下に向かい1セルに書式コピー
Dim gyou, retu, i As Integer


 gyou = ActiveCell.Row ’マウスでクリックした行
 retu = ActiveCell.Column ’マウスでクリックした列
    Selection.Copy
   
  i = 1
 
 If Cells(gyou + i, retu) <> "" Then  '次行にデータある場合
    Cells(gyou + i, retu).Select
     
 Else  '次行にデータない場合
 
   Do Until Cells(gyou + i, retu) <> "" ’データがある行に移動
 
       i = i + 1 ’データのある行を計算させる
         Cells(gyou + i, retu).Select
      If i > 30 Then Exit Do ’空白31行以上は処理終了
   Loop
   
 End If
’自動記録部分(書式貼り付け)
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub





・ワークシートの最後のデータ行に移動する


シートを開けた時、そのシートの最後のデータ行に移動します。
ワークシート名を右クリックし「コードの表示」を選択しマクロを作成します。

Sub Worksheet_Activate() ’シートを開けた時、そのシートの最後のデータ行に移動


Dim jp As Integer
  jp = Cells(1, 1) + 3 ’セルA1に最後のデータ行表示させておく(count関数等使用)
Cells(jp, 2).Select ’最後のデータ行を選択


End Sub


新しいデータを入力する際に便利です。データが増えても自動で移動してくれます。
逆にシートを修正する時には不便になりますが、その時は切り替え用のマクロがあると
良いと思います。