Question

在这里遇到的麻烦很少，我在循环浏览一个大文档并突出显示字符串。我遇到麻烦的地方有两倍，例如

搜索标准＆＃34; aaa＆＃34;在单元格＆＃34; Baaa＆＃34;中，这会突出显示为命中，这在某种程度上是有意义的，但我希望只返回高亮显示字符串和长度完全匹配。另外，我很好奇是否有一种简单的方法来压缩以下内容：

Sub Sample()
Dim MyAr(1 To 1092) As String
Dim ws As Worksheet
Dim aCell As Range, bCell As Range
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1")

MyAr(1) = "R833"
MyAr(2) = "R853"
MyAr(3) = "R873"

With ws
'~~> Loop through the array
For i = LBound(MyAr) To UBound(MyAr)
Set aCell = .Columns(23).Find(What:=MyAr(i), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
Set bCell = aCell
aCell.Interior.ColorIndex = 3

Do
Set aCell = .Columns(23).FindNext(After:=aCell)

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

With ws
'~~> Loop through the array
For i = LBound(MyAr) To UBound(MyAr)
Set aCell = .Columns(24).Find(What:=MyAr(i), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

If Not aCell Is Nothing Then
Set bCell = aCell
aCell.Interior.ColorIndex = 3

Do
Set aCell = .Columns(24).FindNext(After:=aCell)

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

Answer 1

您的LookAt:=xlPart声明中有FIND 将其更改为LookAt:=xlWhole，仅搜索完全匹配。

注意：这意味着整个单元格必须匹配，而不仅仅是单元格中的一个单词。

要在许多单词中找到完全匹配，请使用xlPart但在搜索字词的开头和结尾添加空格 - 搜索＆＃34; aaa＆＃34;而不是＆＃34; aaa＆＃34;。

编辑：看起来您的代码可能会缩短，很遗憾我目前还没有时间查看它。

Answer 2

在@Darren Bartrup-Cook的评论的基础上，您可以缩短它，但我怀疑您是否需要搜索整列？

Sub Sample()

Dim MyAr(1 To 1092) As String
Dim ws As Worksheet
Dim aCell As Range, bCell As Range
Dim i As Long

Set ws = ThisWorkbook.Sheets("Sheet1")

MyAr(1) = "R833"
MyAr(2) = "R853"
MyAr(3) = "R873"

With ws
    '~~> Loop through the array
    For i = LBound(MyAr) To UBound(MyAr)
        Set aCell = .Range("W:X").Find(What:=MyAr(i), LookIn:=xlValues, _
                                       LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
        If Not aCell Is Nothing Then
            Set bCell = aCell
            Do
                aCell.Interior.ColorIndex = 3
                Set aCell = .Range("W:X").FindNext(After:=aCell)
            Loop While aCell.Address <> bCell.Address
        End If
    Next
End With

End Sub

查找多个字符串 - 完全匹配

2 个答案: