3
8

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

個人マクロブック等に保存して利用するVBAの汎用プロシージャ7選

Last updated at Posted at 2024-10-10

VBAのコードは、マクロ有効ブックにコードを記載して、業務で利用する特定のブック(マクロ有効ブック)に紐づいて利用するだけではなく、個人マクロブックやアドインにコードを記載すれば、マクロ有効ブック以外のExcelブックに対してもマクロを利用できます。
(私は、自分で作成したコードを主に自分のみで利用しているため、個人マクロブックにコードを保存しています。他者にコードを配布する場合は、アドインの方が良いかもしれません。)

つきましては、個人マクロブックに保存しておくと便利なプロシージャをご紹介します。
自分が作成したものではないものについては、作成者様のサイトのリンクをご紹介いたしますので、そちらで実際のコードをご確認ください。

1. セル参照のA1形式・R1C1形式の表示を切り替えるマクロ

Excelの表示設定では普段は「A1形式」を利用している方が多数派だと思います。
しかし、VBAの開発を行っているとアルファベットで表記されている列が何列目かを整数で知りたい場合があります。
そういうときには、「R1C1形式」に切り替えするのですが、リボンにマクロを登録してワンタッチでA1形式・R1C1形式を切り替えできるようにしておくと便利です。
【コード】amacoda blog-セル参照のA1形式・R1C1形式の表示を切り替えるマクロ

2. すべてのシートをA1セル選択状態にするマクロ

ExcelはすべてのシートをA1セル選択状態にするマクロです。マナーとして紹介されることもありますね。
個人的にはそこまで徹底する必要はないかなと思いつつ、アクティブセルの保存位置やアクティブなシートによっては、入力されているデータやシートに気づかないことがあるので、登録しておくと便利です。
【コード】和風スパゲティのレシピ-すべてのシートをA1セル選択状態にするマクロ

3. データ整形する

こちらは自作のマクロで、下記を一括で行うマクロです。

  • オートフィルター
  • 列幅調整
  • 見出し以外にデータがない列をグループ化(ヘッダーのみで何も入力されていない列)
  • ウィンドウ枠の固定

基幹システム等から出力した加工前のデータにフィルター等を加える目的で利用します。
私はショートカットキーに登録して実行しています。

コード
ExcelVBA
Sub sbデータ整形()
'オートフィルター&列幅調整&見出し以外にデータがない列をグループ化&ウィンドウ枠の固定
  
    Dim headerRow    As Variant '見出し行数をInputBoxで入力するための変数
    Dim j            As Long    '列カウンター
    Dim lastColomns  As Long
    Dim bordersFlg   As VbMsgBoxResult    '罫線はつけるかのフラグ
 
    Application.ScreenUpdating = False                  '画面更新の停止
   
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.ActiveSheet 'ActiveSheetをwsに設定
  
    With ws
           
        headerRow = Application.InputBox( _
               PROMPT:="見出し行数を入力してください。" & vbCrLf & "(1未満の数値を入力した場合は、1として扱います。)", _
               TITLE:="見出し行数入力", _
               Type:=1)
        If TypeName(headerRow) = "Boolean" Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        '入力された数値が整数か判定(小数点があるならマクロ実行キャンセル)
        If Int(headerRow) <> headerRow Then
            MsgBox "入力された数値が小数点であるためマクロ実行をキャンセルします"
            Exit Sub
        End If
       
        If TypeName(headerRow) = "Boolean" Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        '罫線をつけるかどうかの選択肢:はい、いいえ、キャンセル
        bordersFlg = MsgBox( _
               PROMPT:="罫線を設定しますか?", _
               TITLE:="罫線設定の有無", _
               Buttons:=vbYesNoCancel)
              
        If bordersFlg = vbCancel Then
            MsgBox "マクロ実行をキャンセルします"
            Exit Sub
        End If
       
        If headerRow < 1 Then headerRow = 1 '入力された見出し行数が1未満の場合のみ見出し行数を1として取り扱う
        On Error Resume Next '一時的なエラー無効化(テーブルに対して下記コード実行するとエラーとなるためエラー無効化
        If .AutoFilterMode = False Then
          'オートフィルターが設定されていないならオートフィルターを設定
          .Range("A" & headerRow).EntireRow.Select
          Selection.AutoFilter
        End If
        On Error GoTo 0  'On Errorの無効化
       
        If bordersFlg = vbYes Then '罫線設定するが「はい」なら下記を実行
          .Range("A" & headerRow).CurrentRegion.Borders.LineStyle = xlContinuous
        End If
       
        lastColomns = .Cells(headerRow, Columns.count).End(xlToLeft).Column
        .Range(Columns(1), Columns(lastColomns)).EntireColumn.AutoFit    '列幅を自動調整
        .Range(Columns(1), Columns(lastColomns)).ColumnWidth = Range(Columns(1), Columns(lastColomns)).ColumnWidth + 2 '列幅に余裕を持たせる
          
        For j = lastColomns To 1 Step -1
          If Application.WorksheetFunction.CountA(.Columns(j)) <= 1 Then 'ヘッダなしも含めて1未満
             On Error Resume Next  '一時的なエラー無効化
             '何度もこのマクロ実行すると同じ列のグループ化階層が深くなるため、事前に一度グループ化解除(グループ化していない列を解除するとエラーとなるためエラー無効化)
              .Columns(j).Ungroup
             On Error GoTo 0  'On Errorの無効化
              .Columns(j).Group 'グループ化
             'Debug.Print j '一時確認用
          End If
        Next j
      
     End With
  
    ws.Outline.ShowLevels ColumnLevels:=1
    Range("A" & headerRow + 1).Select
    ActiveWindow.FreezePanes = True  '見出し行の下でウィンドウ枠の固定
    
    Application.ScreenUpdating = True                   '画面更新の開始
    MsgBox "処理が終了しました。", , "処理結果通知"
   
End Sub
ヘッダー(見出し行)が何行目にあるかは、マクロ実行後にInputBoxで尋ねられるので、ヘッダーの行数を入力してください。(例:2) 罫線を設定するかどうかはオプションです。お好みに合わせて都度、選択してください。(こちらも、マクロ実行後にMsgBoxで尋ねられる仕様です。)

マクロ内でアクティブブックを上書き保存するといったことは行っていませんが、マクロ実行後は「戻る」ことができませんので、行われたデータ加工が意に沿わないものであったら元のデータに戻ることができるように、マクロ実行前のデータを保存しておく等の対応はご自身で適宜お願いします。

より詳しい解説は、下記の記事で行っています。
【コード】Qiita-システムから出力したデータをExcelVBAで一瞬で加工する

4. 赤枠背景透明図形の挿入

こちらは自作のマクロで、マニュアル作成等に頻繫に利用する、赤枠で背景透明(=塗りつぶし無し)の図形をアクティブセルの位置に挿入するマクロです。

コード
ExcelVBA
Sub sb赤枠四角図形挿入()
    Call sb赤枠透明図形挿入(msoShapeRectangle)    '図形形状:角が丸い四角
End Sub
 
Sub sb赤枠楕円図形挿入()
  Call sb赤枠透明図形挿入(msoShapeOval)  '図形形状:楕円
End Sub
 
Private Sub sb赤枠透明図形挿入(図形形状 As MsoAutoShapeType)
'MsoAutoShapeTypeはオートシェイプの形状を示す定数
'マニュアル作成作業でよく使用する赤枠・背景透明の図形を挿入する(図形の種類は引数で指定)
   With ActiveCell
        ActiveSheet.Shapes.AddShape _
             (Type:=図形形状, _
              Left:=.Left, Top:=.Top, Width:=100, Height:=50).Select
   End With
   Selection.ShapeRange.Fill.Visible = msoFalse
   With Selection.ShapeRange.line
         .Visible = msoTrue
         .ForeColor.RGB = RGB(255, 0, 0)
         .Weight = 4  '太さ
         .Transparency = 0.3  '透明度
    End With
End Sub

上記のコードは下記の記事で詳しく解説しています。
【コード】Qiita-VBAでプロシージャを部品(パーツ)化して使う

5. 選択画像の外枠線切替

スクリーンショット等の画像をExcelに貼り付けた際に、画像とExcelのワークシートの境目が分かりやすいように、画像に黒い外枠をつけるマクロです。(元々、外枠がついている場合には、外枠をなしにする。)
私は、ショートカットキーを登録して使用しています。
【コード】Excel作業をVBAで効率化‐VBAで図の外枠に線を付ける

6. アクティブブックの非表示のシートを再表示/非表示に戻す

他者が作成したブックの場合は、非表示のシートが隠れていることがあります。
フォーマットの更新履歴シート等、意図的に非表示にしているのであれば問題ありませんが、ときには社外に流出すべきではない情報が記載されている非表示のシートをそのままにして、顧客等の社外に送付し、時には問題になることも。。。

そのため、非表示のシートを一旦再表示してみるときに使います。シートの内容を確認して問題なければ、また非表示に戻します。

アクティブブックに対して実行することで、非表示のシートをシート名の先頭に「【非表示】」とつけて、シートの色をグレーにした上でまとめて表示します。

コード
ExcelVBA
Sub sb非表示シート一括再表示_シート名先頭非表示追加()
    Dim ws As Worksheet
    Dim prefix As String
    prefix = "【非表示】"
    
    For Each ws In Worksheets
        If ws.Visible = xlSheetHidden Then
            ws.Visible = xlSheetVisible
            ws.Name = prefix & ws.Name
            ws.Tab.Color = RGB(89, 89, 89)
        End If
    Next ws
    
End Sub
上記で表示したシートを、シート名の先頭の【非表示】を除外して、非表示に戻します。
コード
ExcelVBA
Sub sb非表示シート一括非表示()
    Dim ws As Worksheet
    Dim sheetName As String
    Dim prefix As String
    prefix = "【非表示】"
    
    ' ワークブック内の全シートをループ
    For Each ws In ActiveWorkbook.Worksheets
        sheetName = ws.Name
        ' シート名の先頭に【非表示】が含まれている場合
        If Left(sheetName, Len(prefix)) = prefix Then
            ' シート名から【非表示】を削除
            ws.Name = Mid(sheetName, Len(prefix) + 1)
            ' シートを非表示に設定
            ws.Visible = xlSheetHidden
        End If
    Next ws
End Sub

「xlSheetHidden」となっているシートは、Excelのシート見出し上で右クリックして表示されるショートカットメニューから[再表示]を選択して、[再表示]ダイアログボックスから、手作業でも再表示できます。
ただし、非表示となっているシートには、「xlSheetHidden」以外に、[再表示]ダイアログボックスにも出てこない「xlSheetVeryHidden」という状態もあります。
参考:インストラクターのネタ帳‐xlSheetVeryHiddenとxlSheetHiddenの違い

紹介したコードでは、「xlSheetVeryHidden」のシートは表示されませんので、「xlSheetVeryHidden」のシートも表示したい場合は、コードをアレンジしてください。

アクティブブックの各シートの状態(表示/非表示、シート保護されているかなど)を取得して表示するユーザーフォームを作成するのも便利です。

7. アクティブブックのすべてのシートの保護を一括で解除する

社内で共有で利用するExcelブックでは、計算式を入力したセルをユーザーに変更されたくないなどの理由で、シートの保護をかける場合があります。
シートの保護をかけると、セルのロックをしていたセルは編集ができなくなります。(シートの保護状態で可能な動作については細かい設定があります。)

こうしたブック内に複数シートがあり、そのすべてにシートの保護をかけている場合に、フォーマットのメンテナンスの際等にまとめてシートの保護を解除したい、ということがあります。
※全シートを選択しても、標準機能では全シートのシートの保護をまとめて解除する機能はありません。

そこで、このマクロを利用します。

コード
ExcelVBA
 
Sub sb全シート一括シート保護解除()
    Call sb全シート一括シート保護解除サブ 
    'Call sb全シート一括シート保護解除サブ("dummy")
End Sub
 
Sub sb全シート一括シート保護解除サブ(Optional a_password As String = "パスワードなし")
    Dim wb As Workbook
    Set wb = ActiveWorkbook
    Dim ws  As Worksheet    'Worksheet用変数
   
    'シートの数だけループする
    If a_password = "パスワードなし" Then
        For Each ws In wb.Sheets
           ws.Unprotect 'シート保護の解除
        Next ws
    Else 'パスワード指定
        For Each ws In wb.Sheets
           ws.Unprotect Password:=a_password    'シート保護の解除
        Next ws
    End If
End Sub

コードは下記のサイトのコードを少しアレンジさせていただきました。
【参考】モノクロの彩り-すべてのシートを一括で保護解除する方法 - コピペでVBA(Excel)

アレンジ箇所としては、サブのプロシージャを作成して、オプションの引数でシート保護時のパスワード設定の有無選択できるようにしている点です。
引数無しで呼び出すならパスワード無しのシート保護解除で、引数有りで呼び出すならパスワード有りのシート保護解除です。(ブック内で各シートのパスワードは共通の前提です。)

sb全シート一括シート保護解除サブの引数は、Optionalで省略可能な引数にしています。省略した場合の引数は「パスワードなし」です。
そうすることで、IF関数内でパスワード設定がある場合とない場合を条件分岐させています。

なるべく色々な方にとって役に立つようなプロシージャを選んでみました。
7選で何となくキリが悪いので、時間があるときに加筆して10選にしたいです。

3
8
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
3
8

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?