Question

我有一堆包含以下文本的行：

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

End Sub

只要单词'dog'是逗号字符串中的第一个单词，这样就可以正常工作，因此它会突出显示第一行而不是第二行，因为'dog'一词出现在'bat'之后。我是否需要先删除逗号，或者有更好的方法吗？

Answer 1

看起来你的最终目标是根据“狗”是否在一个单元格中对行进行着色。这是一种不同的方式，甚至不涉及VBA（这个例子假设你的数据都在A列中）：

在右侧创建一个新列。使用公式=IF(NOT(ISERROR(FIND("dog",A1))),1,0)。您可以稍后隐藏该列，以便用户看不到它。基本上，如果它在某处有“狗”这个词，那么返回1，否则为0。
选择整个第一行
在条件格式下，转到新规则
选择使用公式
对于您的公式，请尝试=$B2=1
现在您已有条件地将一行着色，并将粘贴格式复制到其他行。

现在所有行都应自动更新。

额外信用：如果此数据被格式化为表格对象，条件格式应在添加时自动转移到新行。

Answer 2

继上面我的评论

示例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

<强>截图

enter image description here

示例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

InStr搜索和单元格中的逗号

2 个答案: