3

次のようなテキストを含む行の列がたくさんあります。

dog,cat,mouse
bat,dog,fly
fish,beaver,horse

特定の単語を含む行を検索して強調表示しようとしています:

Public Sub MarkDuplicates()
Dim iWarnColor As Integer
Dim rng As Range
Dim rngCell As Variant
Dim LR As Long
Dim vVal
Dim tRow


LR = Cells(Rows.Count, "B").End(xlUp).Row

Set rng = Range("B1:B" & LR)
iWarnColor = xlThemeColorAccent2

For Each rngCell In rng.Cells
    tRow = rngCell.Row
    If InStr(rngCell.Value, "dog") = 1 Then
        rngCell.Interior.ColorIndex = iWarnColor

    Else
        rngCell.Interior.Pattern = xlNone
    End If
Next

サブ終了

これは、'dog' という単語がコンマ文字列の最初の単語である限り問題なく機能します。したがって、最初の行が強調表示されますが、2 行目ではなく、'dog' という単語が 'bat' の後に現れるためです。最初にカンマを削除する必要がありますか、それとももっと良い方法がありますか?

4

2 に答える 2

5

最終的な目標は、「犬」がセルにあるかどうかに基づいて行に色を付けることです。VBA を使用しない別の方法を次に示します (この例では、データがすべて列 A にあると想定しています)。

  1. 右側に新しい列を作成します。式を使用し=IF(NOT(ISERROR(FIND("dog",A1))),1,0)ます。後で列を非表示にして、ユーザーに表示されないようにすることができます。基本的に、「犬」という単語がどこかにある場合は 1 を返し、そうでない場合は 0 を返します。
  2. 最初の行全体を選択する
  3. [条件付き書式]の下で、 [新しいルール] に移動します。
  4. 式の使用を選択
  5. あなたの式のために、試してください=$B2=1
  6. 1 つの行に条件付きで色を付けたので、書式をコピーして他の行に貼り付けます。

すべての行が自動的に更新されるはずです。

エクストラ クレジット: このデータがテーブル オブジェクトとしてフォーマットされている場合、条件付きフォーマットは、追加された新しい行に自動的に引き継がれます。

于 2013-04-11T19:33:24.820 に答える
3

上記の私のコメントに加えて

例 1 (.Findとを使用.Findnext)

Option Explicit

Public Sub MarkDuplicates()
    Dim ws As Worksheet
    Dim iWarnColor As Integer
    Dim rng As Range, aCell As Range, bCell As Range
    Dim LR As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    iWarnColor = xlThemeColorAccent2

    With ws
        LR = .Range("B" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("B1:B" & LR)

        rng.Interior.ColorIndex = xlNone

        Set aCell = rng.Find(What:="dog", LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell
            aCell.Interior.ColorIndex = iWarnColor
            Do
                Set aCell = rng.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    aCell.Interior.ColorIndex = iWarnColor
                Else
                    Exit Do
                End If
            Loop
        End If
    End With
End Sub

スクリーンショット

ここに画像の説明を入力

例 2 (オートフィルターを使用)

このために、セルに見出しがあることを確認してくださいB1

Option Explicit

Public Sub MarkDuplicates()
    Dim ws As Worksheet
    Dim iWarnColor As Integer
    Dim rng As Range, aCell As Range
    Dim LR As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")

    iWarnColor = xlThemeColorAccent2

    With ws

        '~~> Remove any filters
        .AutoFilterMode = False

        LR = .Range("B" & .Rows.Count).End(xlUp).Row

        Set rng = .Range("B1:B" & LR)

        With rng
            .AutoFilter Field:=1, Criteria1:="=*dog*"
            Set aCell = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
        End With

        If Not aCell Is Nothing Then aCell.Interior.ColorIndex = iWarnColor

        '~~> Remove any filters
        .AutoFilterMode = False
    End With
End Sub
于 2013-04-11T19:35:22.503 に答える