個人マクロブックに登録して汎用的に利用するVBAコード8選
VBAのコードは、マクロ有効ブックにコードを記載して、業務で利用する特定のブック（マクロ有効ブック）に紐づいて利用するだけではなく、個人マクロブックやアドインにコードを記載すれば、マクロ有効ブック以外のExcelブックに対してもマクロを利用できます。
（私は、自分で作成したコードを主に自分のみで利用しているため、個人マクロブックにコードを保存しています。他者にコードを配布する場合は、アドインの方が良いかもしれません。）
つきましては、個人マクロブックに保存しておくと便利なプロシージャをご紹介します。
自分が作成したものではないものについては、作成者様のサイトのリンクをご紹介いたしますので、そちらで実際のコードをご確認ください。
1. セル参照のA1形式・R1C1形式の表示を切り替えるマクロ
Excelの表示設定では普段は「A1形式」を利用している方が多数派だと思います。
しかし、VBAの開発を行っているとアルファベットで表記されている列が何列目かを整数で知りたい場合があります。
そういうときには、「R1C1形式」に切り替えするのですが、リボンにマクロを登録してワンタッチでA1形式・R1C1形式を切り替えできるようにしておくと便利です。
【コード】amacoda blog－セル参照のA1形式・R1C1形式の表示を切り替えるマクロ
2. すべてのシートをA1セル選択状態にするマクロ
ExcelはすべてのシートをA1セル選択状態にするマクロです。マナーとして紹介されることもありますね。
個人的にはそこまで徹底する必要はないかなと思いつつ、アクティブセルの保存位置やアクティブなシートによっては、入力されているデータやシートに気づかないことがあるので、登録しておくと便利です。
【コード】和風スパゲティのレシピ-すべてのシートをA1セル選択状態にするマクロ
３. データ整形する
こちらは自作のマクロで、下記を一括で行うマクロです。
オートフィルター
列幅調整
見出し以外にデータがない列をグループ化（ヘッダーのみで何も入力されていない列）
ウィンドウ枠の固定
基幹システム等から出力した加工前のデータにフィルター等を加える目的で利用します。
私はショートカットキーに登録して実行しています。
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で尋ねられる仕様です。）
マクロ内でアクティブブックを上書き保存するといったことは行っていませんが、マクロ実行後は「戻る」ことができませんので、行われたデータ加工が意に沿わないものであったら元のデータに戻ることができるように、マクロ実行前のデータを保存しておく等の対応はご自身で適宜お願いします。
より詳しい解説は、下記の記事で行っています。
【コード】note-システムから出力したデータを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上記のコードは下記の記事で詳しく解説しています。
【コード】note-VBAでプロシージャを部品（パーツ）化して使い回す
５. 選択画像の外枠線切替
スクリーンショット等の画像をExcelに貼り付けた際に、画像とExcelのワークシートの境目が分かりやすいように、画像に黒い外枠をつけるマクロです。（元々、外枠がついている場合には、外枠をなしにする。）
私は、ショートカットキーを登録して使用しています。
【コード】Excel作業をVBAで効率化‐VBAで図の外枠に線を付ける
６. アクティブブックの非表示のシートを再表示/非表示に戻す
他者が作成したブックの場合は、非表示のシートが隠れていることがあります。
フォーマットの更新履歴シート等、意図的に非表示にしているのであれば問題ありませんが、ときには社外に流出すべきではない情報が記載されている非表示のシートをそのままにして、顧客等の社外に送付し、時には問題になることも。。。
そのため、非表示のシートを一旦再表示してみるときに使います。シートの内容を確認して問題なければ、また非表示に戻します。
アクティブブックに対して実行することで、非表示のシートをシート名の先頭に「【非表示】」とつけて、シートの色をグレーにした上でまとめて表示します。
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上記で表示したシートを、シート名の先頭の【非表示】を除外して、非表示に戻します。
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」のシートも表示したい場合は、コードをアレンジしてください。
【補足２】
アクティブブックの各シートの状態（表示/非表示、シート保護されているかなど）を取得して表示するユーザーフォームを作成するのも便利です。
７. アクティブブックのすべてのシートの保護を一括で解除する
社内で共有で利用するExcelブックでは、計算式を入力したセルをユーザーに変更されたくないなどの理由で、シートの保護をかける場合があります。
シートの保護をかけると、セルのロックをしていたセルは編集ができなくなります。（シートの保護状態で可能な動作については細かい設定があります。）
こうしたブック内に複数シートがあり、そのすべてにシートの保護をかけている場合に、まとめてシートの保護を解除したい、という場合があります。
※全シートを選択しても、標準機能では全シートのシートの保護をまとめて解除する機能はありません。
そこで、このマクロを利用します。
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関数内でパスワード設定がある場合とない場合を条件分岐させています。
8. Enumをセルの選択範囲から自動作成する
Enumは整数のみを取り扱うことができる定数の集合体です。
Excelのデータにあるヘッダーを範囲選択した状態にして、マクロを実行することで、Enumを自動的に作成するコードです。
マクロを実行後に、Enumのコードがクリップボードに格納されているので、VBE画面でペーストすれば、任意の箇所にEnumのコードを貼り付けすることができます。
Sub sb選択範囲よりEnum自動作成しクリップボードへ出力()
'用途：Excelのデータのヘッダーを選択してEnumをクリップボードに出力する
Dim myMsg As String 'メッセージボックス用変数
'enumの名前をmsgboxで入力
Dim enumName As String
enumName = InputBox("enumの名前を入力してください。", "enum作成")
'enumの名前が空白の場合は終了
If enumName = "" Then
MsgBox "enumの名前が入力されませんでした。", vbExclamation, "enum作成"
Exit Sub
End If
'データベースのヘッダーを範囲選択
Dim rng As Range
Set rng = Selection
'列数と行数を取得
Dim colNum As Long
Dim rowNum As Long
colNum = rng.Columns.Count
rowNum = rng.Rows.Count
'選択範囲の最左列を取得
Dim startCol As Long
startCol = rng.Column '選択範囲の左端の列番号
'enumの値をヘッダーから取得
Dim enumValue As String
Dim i As Long
Dim j As Long
Dim k As Long: k = 1
Dim isFirst As Boolean '最初の要素かどうかを判定する変数
enumValue = ""
isFirst = True '最初の要素のフラグをTrueにする
If rowNum > 1 Then GoTo Continue '選択している行が2行の場合には処理中止
For i = 1 To colNum
For j = 1 To rowNum
'空白のセルは無視
If rng.Cells(j, i).Value <> "" Then
'括弧（）などの記号は使用できないため、『_（アンダースコア）』に変換するようにコード改修
'※閉じる方『）』は、空白に置換
Dim cellValue As String
cellValue = rng.Cells(j, i).Value
cellValue = Replace(cellValue, "(", "_")
cellValue = Replace(cellValue, ")", "")
cellValue = Replace(cellValue, "（", "_")
cellValue = Replace(cellValue, "）", "")
cellValue = Replace(cellValue, "【", "_")
cellValue = Replace(cellValue, "】", "")
cellValue = Replace(cellValue, "/", "_")
cellValue = Replace(cellValue, "・", "_")
cellValue = Replace(cellValue, "･", "_")
cellValue = Replace(cellValue, "-", "_")
If isFirst Then '最初の要素の場合は、値の後に「=startCol」を追加する（startColは選択範囲の左端の列数）
enumValue = enumValue & vbTab & cellValue & " =" & startCol & vbNewLine
isFirst = False '最初の要素のフラグをFalseにする
ElseIf i = colNum Then '最終列なら
enumValue = enumValue & vbTab & cellValue & vbNewLine
enumValue = enumValue & vbTab & "[_最終項目]" & vbTab & "'疑似的最終項目" & vbNewLine
enumValue = enumValue & vbTab & "Count = [_最終項目] - 1" & vbNewLine
Else '最初の要素以外の場合
enumValue = enumValue & vbTab & cellValue & vbNewLine
End If
ElseIf rng.Cells(j, i).Value = "" Then '空白の場合はインテリセンスが働かないダミー項目名を追加
enumValue = enumValue & vbTab & "[_dummy_" & k & "]" & vbNewLine
k = k + 1
End If
Next j
Next i
'enumの値の末尾の改行を削除
enumValue = Left(enumValue, Len(enumValue) - 2)
'enumのコードを作成
Dim enumCode As String
enumCode = "Enum ze" & enumName & vbNewLine & enumValue & vbNewLine & "End Enum" & vbNewLine
'enumのコードをクリップボードにセット
sbクリップボードへ文字列セット enumCode
myMsg = "クリップボードにEnumの出力が完了しました。" & vbCrLf + myMsg
MsgBox myMsg, , "処理結果通知"
Exit Sub
Continue: 'GoTo Continueの後はここから処理が行われる
myMsg = "選択行が2行以上のため処理を中止しました。"
MsgBox myMsg, , "処理結果通知"
End Sub
Public Sub sbクリップボードへ文字列セット(ByVal a_text As String)
'クリップボードへ文字列を送信
'必要な参照設定：Microsoft Forms 2.0 Object Library
With CreateObject("Forms.TextBox.1")
.MultiLine = True
.Text = a_text
.SelStart = 0
.SelLength = .TextLength
.Copy
End With
End Subより詳しい解説は、下記の記事で行っています。
【コード】ExcelVBAで定数の代わりにEnum使う & Enumの自動作成
以上の8選です。
なるべく色々な方にとって役に立つようなプロシージャを選んでみました。
8選で何となくキリが悪いので、時間があるときに加筆して10選にしたいです。
2024/10/14 １つプロシージャを追記して7選から8選にしました。
もしよろしければサポートをお願いします。今後の執筆のかてにします。