Excel VBA記録したマクロの修正方法2(初心者向け解説4)

スポンサーリンク
くるみこ
くるみこ

さあ! 前回の続きをはじめますよ!
「マクロの記録」で自動記録したコードの編集の続きです!

前回の「ソート」のところまで少しだけ復習してみました。編集して短くなったコードでも同じ動きをすることがわかりました(^^;

前回記事のおさらいはこの記事を見て確認くださいね(^^)/

くるみこ
くるみこ

前回記事でわかったことは
・「セルを選択」「セルに入力」「ショートカットで移動」「シート」「オートフィルタ」「ソート」処理コードの記録状況が確認できました
・「Select」などの省略できる部分を確認することができました
・省略可能なプロパティや引数も記録されているのでその部分は省略できる
マクロを編集する場合は、実際に動作させながら確認していくことが大事です

今回も「マクロの記録」で記録したコードの修正にチャレンジ継続していきます!

【この記事でわかること】(前回から継続)
・「マクロの記録」で記録したコードの修正はVBA活用の基礎になることがわかります

・VBA上級者でも「マクロの記録」を使って勉強していることがわかります
・自分で考えていろいろやってみることが大事だということがわかります

くるみこ
くるみこ

ただ、1記事で終わらせるにはボリュームがあまりにも大きかったので2回に分けて解説していますm(_ _)m
それでは後半部分の解説をスタートします!

スポンサーリンク

「マクロの記録」で記録したコードを修正してみよう(続編)

「マクロの記録」で自動記録されたマクロ(VBA)は忠実に動作を記録しているがゆえに、無駄な部分もたくさん記録されています。では、さっそく見て行きましょう

フォントオブジェクトを調べる

無駄な部分を修正(編集)していきます(続編)

「印刷実行」「文字の色」「セルの色」「各種罫線」のコード

Sub Macro4()
'
' Macro4 Macro
'

'
    '印刷を実行
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False '引数は全て省略可能
    'フォントとセルに色を付ける
    Range("A1:E1").Select   'セル範囲を選択
    With Selection.Font     'フォントの色を変更
        .Color = -16776961  '色指定
        .TintAndShade = 0   '色の明るさ(0=ニュートラル)
    End With
    With Selection.Font     'フォントの色を元に戻す
        .ColorIndex = xlAutomatic '自動
        .TintAndShade = 0   '色の明るさ(0=ニュートラル)
    End With
    With Selection.Interior 'セルの背景色設定
        .Pattern = xlSolid  '塗りつぶし(網かけ無し)
        .PatternColorIndex = xlAutomatic '自動
        .Color = 65535
        .TintAndShade = 0   '色の明るさ(0=ニュートラル)
        .PatternTintAndShade = 0
    End With
    With Selection.Interior 'セルの背景色を元に戻す
        .Pattern = xlNone   '塗りつぶしなし
        .TintAndShade = 0   '色の明るさ(0=ニュートラル)
        .PatternTintAndShade = 0
    End With
    'ここから罫線の設定
    '右下がり斜め線なし
    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(xlEdgeTop)   '上部
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom) '下辺
        .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(xlInsideVertical) '内側の垂直線
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal) '内側の水平線
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium      '
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlDouble
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
  'ここでボタンを押そうとしましたが押せませんでした
    Range("F5").Select
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 5")).Select
    Range("E6").Select
End Sub

・修正(編集)したVBAコード

'いらない部分を編集したコード
Sub Macro4_改()
    '印刷を実行
    ActiveWindow.SelectedSheets.PrintOut '引数は全て省略可能
    'フォントとセルに色を付ける
    'フォントの色を指定
    With Range("A1:E1")
        'フォントの色を変更
        .Font.Color = -16776961  '色指定
        'フォントの色を戻す
        .Font.ColorIndex = xlAutomatic '自動
        'セルの色設定
        .Interior.Color = 65535      '黄色
        'セルの色を元に戻す
        .Interior 'セルの背景色を元に戻す
        .Pattern = xlNone   '塗りつぶしなし
        'ここから罫線の設定
        '左辺の設定
        .Borders(xlEdgeLeft).LineStyle = xlContinuous '直線
        '上部
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        '下辺
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        '右辺
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        '内側の垂直線
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        '内側の水平線
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    With Range(Range("A2"), Range("A2").End(xlDown))
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium '中太線      '
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick '太線
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThick '太線
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
End Sub

【印刷実行】
・必要なのは「PrintOut」だけです。それ以降の引数は全て省略可能です
【文字(Font)の色】
・「Color」と「ColorIndex」以外のデフォルトの部分は省略可能です
【セルの色】
・文字の色と同じです
【各種罫線】
・セルの罫線は、Rangeオブジェクト内のBorderオブジェクトで表されます
・「LineStyle」プロパティに「直線」「破線」「一点鎖線」などを表す定数を指定します
・直線の定数は「xlContinuous」で、罫線なしの定数は「xlLineStyleNone
・線の太さは「Weight」で定数「xlThin」がデフォルト細線です
・線の色は「ColorIndex」で「黒=0」がデフォルトです
・省略できるのはデフォルトの部分です。全部省略します

基本として「Select」と「Selection」は消し込むようにしています
 Selectの多用は速度的に良くありません。画面が動くのも非常にわずらわしいです
 「マクロの記録」は操作したことを忠実にコード化しますが、決して最適化されたコードは生成してくれません。その例は、セルをコピーする手順です。「コピー元を選択」→「選択セルをコピー」→「コピー先を選択」→「選択シートに貼り付け」という動きです。これは「コピー先セル」に「コピー元セル」から直接代入すれば1回で済んでしまいます

「セル・行・列」の挿入・削除とコピーして挿入・削除する

Sub Macro5()
'
' Macro5 Macro
'

'
    Range("B3").Select              'B3セルにセルを挿入
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Delete Shift:=xlUp    '挿入したセルを削除
    Rows("5:5").Select              '5行目を選択して挿入
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Delete Shift:=xlUp    '挿入した行を削除
    Columns("B:B").Select           'B列を選択して列を挿入
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Delete Shift:=xlToLeft '挿入した列を削除
    Range("C1").Select
    Selection.Copy      'C1セルを選択してコピー
    Range("B5").Select  'B5セルを選択
    Selection.Insert Shift:=xlDown 'コピーしたセルを挿入(下にシフト)
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("5:5").Select  '5番目の行を選択
    Selection.Copy      '選択した行をコピー
    Rows("6:6").Select  '6番目の行を選択
    Selection.Insert Shift:=xlDown 'コピーした行を挿入
    Rows("5:5").Select  '5番目の行を選択
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp '選択した行を削除
    Columns("B:B").Select   'B列を選択
    Selection.Copy          '選択列をコピー
    Columns("C:C").Select   'C列選択
    Selection.Insert Shift:=xlToRight 'コピーした列を挿入
    Columns("B:B").Select   'B列を選択
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft '選択した列を削除
End Sub

・修正(編集)したVBAコード

'いらない部分を編集したコード
Sub Macro5_改()
    Range("B3").Insert Shift:=xlDown 'B3セルにセルを挿入
    Range("B3").Delete Shift:=xlUp    '挿入したセルを削除
    Rows("5:5").Insert Shift:=xlDown '5行目に挿入
    Rows("5:5").Delete Shift:=xlUp    '挿入した行を削除
    Columns("B:B").Insert Shift:=xlToRight 'B列に列を挿入
    Columns("B:B").Delete Shift:=xlToLeft '挿入した列を削除
    Range("B5").Insert Shift:=xlDown 'B5セルにセルを挿入(下にシフト)
    Range("B5") = Range("C1") 'B5セルにC1セルをコピー
    Range("B5").Insert Shift:=xlToRight 'B5セルに挿入(右にシフト)
    Rows("6:6").Insert Shift:=xlDown '6番目の行に行を挿入(下にシフト)
    Rows("6:6").Value = Rows("5:5").Value '6番目の行に5番目の行をコピー
    Rows("5:5").Delete Shift:=xlUp    '5番目の行を削除
    Columns("C:C").Insert Shift:=xlToRight 'C列に列を挿入(右にシフト)
    Columns("C:C").Value = Columns("B:B").Value
    Columns("B:B").Delete Shift:=xlToLeft  'B列を削除
End Sub

基本として「Select」と「Selection」は全て消し込むようにしています
・「Copy」も行わないようにしています
・「Copy」したセルをコピー先に挿入する動作は、先に挿入を行いデータを代入しています
・行と列の場合も同様です
・「CopyOrigin:=xlFormatFromLeftOrAbove」は書式のコピーです。省略した場合「CopyOrigin:=xlFormatFromLeftOrAbove」が規定なので省略可能です

「Select」と「Selection」は消し込むようにしていることがわかりました。
それから「Copy」や「Paste」もですね。あと、既定の場合は省略してもいいみたいですね。まだまだおぼろげだけど、なんとなく感じはつかめたかもしれません!

くるみこ
くるみこ

そうだよね!
でも、今回の自動記録されたコードの修正は、いらない部分を削除しただけの編集なんだよね。まだまだ最適化できるところがたくさんあるんだよ(^^)
それは、次の機会にまた少しずつやっていこうね!

・今回はここまでで終了です!
・まだまだ続きがあります。次回記事まで少しお待ちください・・・(^^)/

まとめ(おわりに)

まとめと感想など

・修正前と修正後のコードをそれぞれ動作させてみてください
・修正後の動作の方が少しだけ早くなっているように感じると思います
・画面の動きも少なくなっていると思います
基本として「Select」と「Selection」は使わず消し込むようにしました
・「Copy」も極力行わないようにした方が良いでしょう
・省略可能な引数などの規定値データはわからない場合はHELPなどで確認しましょう
・繰り返しになりますが、マクロを編集する場合は、実際に動作させながら確認していくことが大事です

マクロ(VBA)を実行する際は必ずバックアップを取ってから行ってください
・マクロ(VBA)は実行後にファイルを保存すると元に戻すことはできません!
・実行後にファイルを保存せず終了すれば、実行前に戻すことができます!


ブログランキングに参加しています(^^)応援よろしくお願いしますm(_ _)m
にほんブログ村 IT技術ブログ VBAへ
にほんブログ村

Visual Basicランキング

今後の記事について

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
是非!サンプルファイルをダウンロード出来ますのでそのまま使ってみてください(^^)/
当面は今回の記事に続き「初心者向けマクロ」の記事を継続して書いていきます

【検討中の今後の記事内容は・・・・・】
・実務に役立つものを提供できるよう現在検討中です
・その他雑記的に「小ネタなどいろいろ」・・・・・
・今後の記事にご期待ください(^^)/

サンプルファイルをダウンロードできます(下記リンク先へ)

記事で使用したサンプルファイルがダウンロードできるページを設置しています
こちら(このリンク先)からご利用ください