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”是逗号字符串中的第一个单词，它就可以正常工作，因此它将突出显示第一行而不是第二行，因为单词“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. 现在您已经有条件地为一行着色，将格式复制并粘贴到其他行。

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

额外积分：如果此数据被格式化为表格对象，则条件格式应在添加新行时自动延续到新行。

于 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 回答