【エクセルVBA】特定の文字列を含むセルへ、一括で色を付けるVBA

あのー、ExcelのVBAで、特定の文字列を含むセルへ、一括で色を付けることは可能ですか？？

はい、可能ですよ。

本当ですか、教えてほしいです！！

サンプルコードをご紹介しましょう！

Excelの特定の文字列を含むセルへ、一括で色を付けるコードをご紹介します。

マクロ機能が有効なExcelブック「.xlsm」を作成

Excelブック「.xlsm」の作成方法が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】マクロ機能が有効なExcelブック「.xlsm」の作り方

コードを標準モジュールに貼り付け

標準モジュールの開き方が不明な場合は、下記の記事を参考にして下さい。
【エクセルVBA】標準モジュールの開き方

標準モジュールを開いて、下記のコードを貼り付けて下さい。

コード

特定の文字列を含むセルへ、一括で色を付ける

本記事では、「特定の文字列＝「XXX」としています。
下記コードの「XXX」部分を希望の文字列に変更することで、
他の文字列でもマクロ実行可能です。

Sub SearchAndHighlightXXX()
    Dim ws As Worksheet
    Dim cell As Range
    Dim searchRange As Range
    Dim firstAddress As String
    Dim found As Boolean

    ' アクティブなシートを取得
    Set ws = ActiveSheet
    
    ' シート内の検索範囲を指定 (A1から最終セルまで)
    Set searchRange = ws.UsedRange

    ' 初期化: 一度も見つからなかった場合のフラグ
    found = False

    ' 検索を開始
    With searchRange
        Set cell = .Find("XXX", LookIn:=xlValues, LookAt:=xlPart)
        
        If Not cell Is Nothing Then
            firstAddress = cell.Address
            Do
                ' セルの背景色を黄色に変更
                cell.Interior.Color = vbYellow
                
                ' 見つかったフラグをTrueに設定
                found = True
                
                ' 次の一致を検索
                Set cell = .FindNext(cell)
            Loop While Not cell Is Nothing And cell.Address <> firstAddress
            
            'メッセージ表示
            MsgBox "処理完了しました。処理を終了します。", vbExclamation
        End If
        
    End With
    
    ' 「XXX」を含むセルが1件も見つからなかった場合のメッセージ表示
    If Not found Then
        MsgBox "対象の文字列を含むセルが存在しません。処理を終了します", vbExclamation
    End If
End Sub

Sub SearchAndHighlightXXX()

Dim ws As Worksheet

Dim cell As Range

Dim searchRange As Range

Dim firstAddress As String

Dim found As Boolean

' アクティブなシートを取得

Set ws = ActiveSheet

' シート内の検索範囲を指定 (A1から最終セルまで)

Set searchRange = ws.UsedRange

' 初期化: 一度も見つからなかった場合のフラグ

found = False

' 検索を開始

With searchRange

Set cell = .Find("XXX", LookIn:=xlValues, LookAt:=xlPart)

If Not cell Is Nothing Then

firstAddress = cell.Address

' セルの背景色を黄色に変更

cell.Interior.Color = vbYellow

' 見つかったフラグをTrueに設定

found = True

' 次の一致を検索

Set cell = .FindNext(cell)

Loop While Not cell Is Nothing And cell.Address <> firstAddress

'メッセージ表示

MsgBox "処理完了しました。処理を終了します。", vbExclamation

End If

End With

' 「XXX」を含むセルが1件も見つからなかった場合のメッセージ表示

If Not found Then

MsgBox "対象の文字列を含むセルが存在しません。処理を終了します", vbExclamation

End If

End Sub

マクロを実行

上記で作成したマクロファイル（ここでは「マクロ作成_特定の文字列を含むセルカラー設定.xlsm」とファイル名を設定。）を準備します。

マクロファイルを開いて、「コンテンツの有効化」をクリックします。
※設定により、「コンテンツの有効化」は表示されない（クリック不要の）場合もあります。

本ファイルには予め「Sheet1」にAとXを組み合わせて下記の様に入力しています。

「開発」タブ、「マクロ」の順にクリックします。

マクロ「SearchAndHighlightXXX」を選択、「実行」をクリックします。

メッセージが実行されます。「OK」をクリックします。

マクロが実行され、「XXX」を含むセルが黄色に変更されます。

完了です。

特定の文字列が含まれる、合致するセルが存在しない場合

下記の様に、特定の文字列（今回ですと「XXX」）が含まれないシートで、
マクロを実行してみます。

「対象の文字列を含むセルが存在しません。」とメッセージが表示されます。
「OK」をクリックするとマクロは終了します。セルに変更等、処理はされません。

参考サイト

ChatGPTを活用して、修正を加えてコードを作成しました。