[[20210909094640]]　『特定の文字列（複数あり）を含むセルの色を変更す』（ここあ）　ページの最後に飛ぶ

『特定の文字列（複数あり）を含むセルの色を変更するVBA』（ここあ）

お世話になります。

特定の文字列（複数あり）を含むセルの色を変更するVBAはありますでしょうか？
検索したい文字列は全てC列にあり、C列の特定の文字を含むセルのみ背景色を変更したいです。
また、特定の文字列が20個ほどあり、検索で見つけた下記のVBAだと行が長すぎます。というようなエラーがでてしまいました。
また、下記VBAだと行全体が塗りつぶされてしまうので、文字列を含むセルのみ色を付けたいです。
詳しい方ぜひご教示くださいますと幸いです。
宜しくお願い致します。

'プログラム1｜プログラム開始
Sub ColorRowsWithKeywords()

    'プログラム2｜キーワードを入力
    Dim keywords As String
    keywords = InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること")

    'プログラム3｜キーワードがない場合、プログラムを終了
    If keywords = "" Then: Exit Sub

    'プログラム4｜シート設定
    Dim ws As Worksheet
    Set ws = ActiveSheet

    'プログラム5｜シートの最右列を取得
    Dim col As Long
    col = ws.UsedRange.Columns.Count

    'プログラム6｜変数設定
    Dim rng As Range
    Dim keyword As Variant

    'プログラム7｜2行目以降を行ごとに取得
    Dim i As Long
    For i = 2 To ws.UsedRange.Rows.Count
        Set rng = ws.UsedRange.Rows(i)

        'プログラム8｜対象行にデータが含まれていなければプログラム11へ
        If WorksheetFunction.CountA(rng) = 0 Then: GoTo Continue

        'プログラム9｜プログラム2の全キーワードを繰り返し処理
        For Each keyword In Split(keywords, ",")

            'プログラム10｜各行にキーワードを含むセルがあれば行を黄色、なければ色をなくす
            If Not rng.Find(keyword, Lookat:=xlPart) Is Nothing Then
                ws.Range(Cells(i, 1), Cells(i, col)).Interior.ColorIndex = 6
                Exit For
            Else
                ws.Range(Cells(i, 1), Cells(i, col)).Interior.ColorIndex = xlNone
            End If
        Next

'プログラム11｜プログラム8のジャンプ先
Continue:

    Next

'プログラム12｜プログラム終了
End Sub

＜使用 Excel：Excel2016、使用 OS：unknown ＞

まずは、C列に限定する修正はできますか？

（γ） 2021/09/09(木) 10:25

VBA初心者のためC列に限定する方法もわからず困っております…
お力添えいただけますと幸いです。
（ここあ） 2021/09/09(木) 10:32

初心者さんなら、なおさらご自分でトライすることをお奨めします。

「セルの指定方法」については、下記が参考になるかと思います。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html
Cells(k,"C")といった使い方や、
Endを使った最終行の求め方など、
これらが不明なら、基本テキストを復習するのが遅いようで近道ですね。

（γ） 2021/09/09(木) 10:40

１か月ほど色々変えて試してみたのですが全然思うように動いてくれず…
行き詰っての相談でした。
もう少しなんとか頑張ってみます…
（ここあ） 2021/09/09(木) 11:06

どのように修正してみたのか、それを示してもらえますか？

（γ） 2021/09/09(木) 11:37

'プログラム開始

 Sub SearchSample()

'プログラム1

    'プログラム1-1｜変数設定
    Dim Keywords    As Variant
    Dim SearchRange As Range
    Dim ColorRGB    As Long

    'プログラム1-2｜検索キーワードを設定
    Keywords = Split(InputBox("抽出の対象となる文字列を記入。複数ある場合は、「,」で区分けすること"), ",")

    'プログラム1-3｜検索範囲を設定
    Set SearchRange = Application.InputBox("検索の対象となるセル範囲を記入", Type:=8)

    'プログラム1-4｜色を設定
    ColorRGB = RGB(255, 255, 0)

'プログラム2

    'プログラム2-1｜変数設定
    Dim iRange       As Range
    Dim firstAddress As String
    Dim Keyword      As Variant

    'プログラム2-2｜検索範囲セルの色をなくす
    SearchRange.Interior.Color = xlNone

    'プログラム2-3｜プログラム1の全キーワードを繰り返し処理
    For Each Keyword In Keywords

        'プログラム2-4｜検索範囲からキーワードを含むセルを探す
        Set iRange = SearchRange.Find(What:=Keyword, LookIn:=xlValues, LookAt:=xlPart)

        'プログラム2-5｜検索にかかるセルがあった場合だけ処理
        If Not iRange Is Nothing Then

            'プログラム2-6｜最初に検索にかかったセルのアドレスを記録（無限ループ防止用）
            firstAddress = iRange.Address

            'プログラム2-7｜ループ開始（プログラム2-7'まで）
            Do

                'プログラム2-8｜検索にかかったセルの色を変える
                iRange.Interior.Color = ColorRGB

                'プログラム2-9｜プログラム2-4と同一条件で次のセルを検索
                Set iRange = SearchRange.FindNext(iRange)

            'プログラム2-7'｜プログラム2-6で記録したセルと検索にかかったセルのアドレスが同一になるまでループ
            Loop Until iRange.Address = firstAddress

        End If
    Next
 End Sub

比較試用のためのサンプルです。
研究用にどうぞ。
（めざめるパワー） 2021/09/09(木) 13:19

コメント返信：

[ 一覧(最新更新順) ]

[[20210909094640]] 『特定の文字列（複数あり）を含むセルの色を変更す』（ここあ） ページの最後に飛ぶ

[[20210909094640]]　『特定の文字列（複数あり）を含むセルの色を変更す』（ここあ）　ページの最後に飛ぶ