よく使うVBAマクロ集

概要

エクセルのあちこちに散らばった複数の単語をハイライトしたり、クリック一発でまとめてA1選択したり、全ページ指定倍率にしたり、赤枠図形をサクッと作成したい瞬間はありませんか。
私はありました。
よく使う操作はクイックアクセスツールバーに入れて時短してます。

手元の下記環境で動作確認しています。

環境

Windows11
Microsoft Office Professional Plus 2019

VBA、マクロ

修正箇所のクイック確認に「コピーした複数文字列（改行区切り）を一発でハイライトしてくれる」マクロ

何に使うのかというと、Excelの資料を確認をする際などにまとめてハイライトして修正箇所をチェックしやすくします。
Excelで資料見なきゃいけないけどやりたくない場合につかいましょう。
青とオレンジを作ってクイックアクセスツールバーに登録するのがおすすめです。
下記のマクロだとDataObjectの参照設定不要で使えました。

入力：改行区切り文字列（コピーすればOK）
検索対象:1シート全体
ハイライト対象:入力された文字列のあるセルの背景色（文字色変更ではない）

こういうことがしたい時におすすめです。
クイックアクセスツールバーにいれて汚していい資料を塗りつぶしながら品質を上げましょう。

Sub HighlightWordsFromClipboard()
    Dim words() As String
    Dim w As Variant
    Dim rng As Range
    Dim cell As Range
    Dim hitCount As Long
    Dim mode As VbMsgBoxResult
    Dim clipText As String

    ' 検索モード選択
    mode = MsgBox( _
        "検索モードを選択してください" & vbCrLf & vbCrLf & _
        "はい：部分一致" & vbCrLf & _
        "いいえ：完全一致" & vbCrLf & _
        "キャンセル：終了", _
        vbYesNoCancel + vbQuestion, _
        "検索モード選択" _
    )

    If mode = vbCancel Then Exit Sub

    ' --- クリップボード取得 ---
    Dim obj As Object
    Set obj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    obj.GetFromClipboard
    clipText = obj.GetText

    If Trim(clipText) = "" Then Exit Sub

    words = Split(clipText, vbCrLf)

    Application.ScreenUpdating = False

    hitCount = 0
    Set rng = ActiveSheet.UsedRange   ' 検索対象：そのシート

    For Each cell In rng.Cells
        If Not IsError(cell.Value) Then
            For Each w In words
                If Trim(w) <> "" Then
                    If mode = vbYes Then
                        ' 部分一致
                        If InStr(1, cell.Value, w, vbTextCompare) > 0 Then
                            cell.Interior.Color = RGB(255, 192, 0)
                            hitCount = hitCount + 1
                            Exit For
                        End If
                    ElseIf mode = vbNo Then
                        ' 完全一致
                        If StrComp(cell.Value, w, vbTextCompare) = 0 Then
                            cell.Interior.Color = RGB(255, 192, 0)
                            hitCount = hitCount + 1
                            Exit For
                        End If
                    End If
                End If
            Next w
        End If
    Next cell

    Application.ScreenUpdating = True

    MsgBox hitCount & " 件をハイライトしました", vbInformation, "完了"
End Sub

確認したセルの背景を「黒く塗りつぶす/白に戻す」トグルマクロ

順序があるシートで見た場所をマークするのに使っています。
背景色を戻すクイックアクセスツールバーやショートカットキーが存在しないので入れています。
クリックするたびに白と黒が入れ替わります。気分はマークシートですね。

Sub ToggleBlackFill()
    Dim c As Range
    Dim hasBlack As Boolean
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    ' まず黒セルが含まれているかチェック
    hasBlack = False
    For Each c In Selection
        If c.Interior.Color = RGB(0, 0, 0) Then
            hasBlack = True
            Exit For
        End If
    Next c
    
    ' 黒が含まれていれば解除、なければ黒塗り
    For Each c In Selection
        If hasBlack Then
            c.Interior.Pattern = xlNone
        Else
            c.Interior.Color = RGB(0, 0, 0)
        End If
    Next c
End Sub

100枚以上あるシートの選択の頻繁な移動に便利な「シート選択表示」マクロ

参考

Excelの左下の間を右クリックすると出てくるやつです。

100枚ぐらいあるシートを移動するためだけにいちいち左下を右クリックしてられないですよね。
しかもこういうのを作ろうとすると必ずユーザーフォーム（VBAのUIみたいなコード化できないやつ）をおすすめされるのでね、この方法はユーザーフォーム使わないでできるので大変便利ですね。

Sub SheetSelectDialog()
   With CommandBars.Add(Temporary:=True)
       .Controls.Add(ID:=957).Execute
       .Delete
   End With
End Sub

ファイル倍率やカーソルが揃ってない場合用「倍率指定A1選択」マクロ

倍率指定用、大量のファイルを見なきゃいけないのにブックごとに倍率が揃ってない場合に使います
倍率は必要に応じて毎回自分で見やすいサイズにいじって使っています。

Sub ZoomByA1()
    ActiveWindow.Zoom = 70   '倍率指定する(%)
    ActiveSheet.Range("A1").Select
End Sub

マウスでホーム(A1)飛びたい人向け

A1選択されてない資料でショートカットキー押したくない人向けマクロ

Sub SelectA1()
    ActiveSheet.Range("A1").Select
End Sub

いますぐ押しやすいボタンでzoomを上げたい「+10% -10%」マクロ

右下とかホイールで倍率上げ下げしたくない人向け

拡大率+10%

Sub ZoomPlus10()
    ActiveWindow.Zoom = ActiveWindow.Zoom + 10
End Sub

拡大率-10%

Sub ZoomMinus10()
    ActiveWindow.Zoom = ActiveWindow.Zoom - 10
End Sub

選択中のセルにそって赤枠オブジェクトを作るマクロ

画像を赤枠でかこって強調表示したいときにいちいち図形から作るのが面倒なので作りました。
↓こういうのです。選択セルに赤枠オブジェクトが出現します。

Sub AddRedBorderRectangleToCell()
    Dim targetCell As Range
    Dim shp As Shape
    
    ' 対象セルを指定(選択中のセルを使う場合)
    Set targetCell = Selection
    
    ' すでに同名の図形があれば削除(再実行対応)
    On Error Resume Next
    ActiveSheet.Shapes("CellBorderRect_" & targetCell.Address(False, False)).Delete
    On Error GoTo 0
    
    ' セルの位置・サイズに合わせて四角形を作成
    Set shp = ActiveSheet.Shapes.AddShape( _
        msoShapeRectangle, _
        targetCell.Left, _
        targetCell.Top, _
        targetCell.Width, _
        targetCell.Height)
    
    With shp
        .Name = "CellBorderRect_" & targetCell.Address(False, False)
        .Fill.Visible = msoFalse          ' 塗りつぶしなし(透明)
        .Line.Visible = msoTrue
        .Line.ForeColor.RGB = RGB(255, 0, 0)  ' 赤色
        .Line.Weight = 2                       ' 線の太さ(pt)
        .Placement = xlMove                    ' セルと一緒に移動(サイズは追従しない)
    End With
End Sub

使い方：開発リボン表示方法から、クイックアクセスツールバー登録まで

最後に、開発リボン表示方法-マクロ作成-クイックアクセスツールバー登録までを追っていきます。

開発リボンを出す：
ファイル→オプション→リボンのユーザー設定→「開発」にチェックして「OK」

標準モジュールへの追加：
開発→コードの表示

開いているフォルダを右クリック→挿入→標準モジュール

出てきたWindowにコードを貼り付け

保存するとダイアログが出てくるので「戻る」をクリック

ファイル名を変更して、「Excelアドイン」を選択
（アドインのパスもメモ帳などに保存しておく「C:\Users\YOUR_NAME\AppData\Roaming\Microsoft\AddIns」など、もし動かなかったらトラストセンターから信頼済みの場所に登録してExcel再起動）

開発→Excelアドイン→参照→先程のアドインのファイルを選択→OK

アドインがチェックされているのを確認してOK

ファイル→オプション→クイックアクセスツールバー→コマンドの選択「マクロ」→さっき作ったマクロの関数名を選択→「追加>>」→OK
マクロはなぜか２個ぐらい出る時があるけどどっちでもいいと思う。

セルを選択して左上の増えたマークをクリック、セルが黒くなる（マクロの効果）はず。

アイコンはさっきのページで変更できるので変更しよう

Altキー+数字でショートカットもできる。

おわり。