ツールマクロ

2017/12/17 07:35

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

マクロ学習法とは 14（自動記録？） - 趣味のエクセルで当てようロト・ナンバーズ

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

シート「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 copymotoAs String, 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 As long, retu As long, i As long

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()　 '同じ列で下に向かい１セルに書式コピー
Dim gyou As long, retu As long, i As long

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