查找并突出显示包含特定文本的单元格

Question

我是 VBA 的新手，我正在尝试创建一个 Sub，它可以查找并突出显示工作表中包含特定文本的任何单元格。

我在 link.

中模仿了 Pradeepta Pradhan 的代码

我写的子能用，但是速度特别慢。关于如何加速或清理我的代码的任何提示？

Sub Find_Highlight_Comments3()
    Dim WS As Worksheet
    Dim Rng As Range
    Dim Match As Range
    Dim Comment As String

    Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")
    Set Rng = WS.UsedRange
    Comment = ("insoluble residue")
    Comment = ("non-gaussian")
    Comment = ("empty source well")
    Comment = ("source vial not received")
    Comment = ("foreign object")
    Comment = ("lacks nitrogen")
    Comment = ("lacks molecular")
    Comment = ("could not be assayed")
    Comment = ("not pass through Millipore filter")
    For Each Rng In Rng
    With Rng
        Set Match = WS.Cells.Find(What:=Comment, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not Match Is Nothing Then
                Match.Interior.Color = RGB(255, 255, 0)
            End If
    End With
    Next Rng
End Sub

Answer 1

对您的代码稍作修改。正如您提到的 Pradeepta Pradhan 的 post，我添加了额外的行以用红色字体突出显示评论文本。同post.

下面可以参考Siddharth's post

我已将所有这些评论放入评论数组中。如果您想再添加两条评论，则首先将 redim 语句更改为 10。请注意，数组从索引 0 开始。此外，如果您想查找同一评论的所有后续出现，仅查找是不够的。因此，也添加了 findnext。

Sub Find_Highlight_Comments3()
Dim WS As Worksheet
Dim Match As Range
Dim Comment() As String

Set WS = ActiveWorkbook.Worksheets("Report Sheet 1")

ReDim Comment(8)
    Comment(0) = "insoluble residue"
    Comment(1) = "non-gaussian"
    Comment(2) = "empty source well"
    Comment(3) = "source vial not received"
    Comment(4) = "foreign object"
    Comment(5) = "lacks nitrogen"
    Comment(6) = "lacks molecular"
    Comment(7) = "could not be assayed"
    Comment(8) = "not pass through Millipore filter"

For i = LBound(Comment) To UBound(Comment)
Set Match = WS.Cells.Find(What:=Comment(i), LookIn:=xlValues, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not Match Is Nothing Then
    FirstAddress = Match.Address
        Do
        sPos = InStr(1, Match.Value, Comment(i))
        sLen = Len(Comment(i))
        Match.Characters(Start:=sPos, Length:=sLen).Font.Color = RGB(255, 0, 0)
        Match.Interior.Color = RGB(255, 255, 0)
        Set Match = WS.Cells.FindNext(Match)
        Loop While Not Match Is Nothing And Match.Address <> FirstAddress
    End If
Next
End Sub

查找并突出显示包含特定文本的单元格

Find and Highlight Cells Containing Specific Text

excel

vba

conditional-formatting