Question

我希望有一个代码可以突出显示搜索到的每个单词。我已经有了一些代码，除了第30行之后它开始突出显示所有内容。为了清楚起见，我会添加图片。我不知道我的代码有什么问题或者我可以解决的问题。

这是我的代码。

Sub Highlight()
Application.ScreenUpdating = False
Dim Rng As Range
Dim cFnd As String
Dim xTmp As String
Dim x As Long
Dim m As Long
Dim y As Long
cFnd = ComboBox1.Value
y = Len(cFnd)
For Each Rng In Selection
  With Rng
    m = UBound(Split(Rng.Value, cFnd))
    If m > 0 Then
      xTmp = ""
      For x = 0 To m - 1
        xTmp = xTmp & Split(Rng.Value, cFnd)(x)
        .Characters(Start:=Len(xTmp) + 1, Length:=y).Font.ColorIndex = 3
        xTmp = xTmp & cFnd
      Next
    End If
  End With
Next Rng
Application.ScreenUpdating = True
End Sub

这是将搜索结果带到图片中显示的页面的搜索代码。

Sub FindOne()

Range("B19:J5000") = ""

Application.ScreenUpdating = False

Dim k As Integer, EndPasteLoopa As Integer, searchColumn As Integer, searchAllCount As Integer
Dim myText As String
Dim totalValues As Long
Dim nextCell As Range
Dim searchAllCheck As Boolean

k = ThisWorkbook.Worksheets.Count
myText = ComboBox1.Value
Set nextCell = Range("B20")
If myText = "" Then
    MsgBox "No Address Found"
    Exit Sub
End If

Select Case ComboBox2.Value
    Case "SEARCH ALL"
        searchAllCheck = True
    Case "EQUIPMENT NUMBER"
        searchColumn = 1
    Case "EQUIPMENT DESCRIPTION"
        searchColumn = 3
    Case "DUPONT NUMBER"
        searchColumn = 6
    Case "SAP NUMBER"
        searchColumn = 7
    Case "SSI NUMBER"
        searchColumn = 8
    Case "PART DESCRIPTION"
        searchColumn = 9
    Case ""
        MsgBox "Please select a value for what you are searching by."
End Select

For I = 2 To k
    totalValues = Sheets(I).Cells(Rows.Count, "A").End(xlUp).Row
    ReDim AddressArray(totalValues) As String

    If searchAllCheck Then
        searchAllCount = 5
        searchColumn = 1
    Else
        searchAllCount = 0
    End If

    For qwerty = 0 To searchAllCount
        If searchAllCount Then
            Select Case qwerty
                Case "1"
                    searchColumn = 3
                Case "2"
                    searchColumn = 6
                Case "3"
                    searchColumn = 7
                Case "4"
                    searchColumn = 8
                Case "5"
                    searchColumn = 9
            End Select
        End If

        For j = 0 To totalValues
            AddressArray(j) = Sheets(I).Cells(j + 1, searchColumn).Value
        Next j

            For j = 0 To totalValues
            If InStr(1, AddressArray(j), myText) > 0 Then
                EndPasteLoop = 1
                If (Sheets(I).Cells(j + 2, searchColumn).Value = "") Then EndPasteLoop = Sheets(I).Cells(j + 1, searchColumn).End(xlDown).Row - j - 1
                For r = 1 To EndPasteLoop
                    Range(nextCell, nextCell.Offset(0, 8)).Value = Sheets(I).Range("A" & j + r, "I" & j + r).Value
                    Set nextCell = nextCell.Offset(1, 0)
                Next r
            End If
        Next j
    Next qwerty
Next
Application.ScreenUpdating = True
Range("A1").Select
End Sub

谢谢！

Answer 1

这是一种做你想做的事情的方法，但是以一种更直接的方式：

Sub HighlightCell(Rng As Range, cFnd As String)
    'highlights all nonoverlapping occurrences of cFnd in Rng (which is assumed to be a single cell)
    Dim s As String
    Dim i As Long, y As Long
    y = Len(cFnd)
    s = Rng.Value
    With Rng
        i = InStr(1, s, cFnd)
        Do While i > 0
          .Characters(Start:=i, Length:=y).Font.ColorIndex = 3
          i = InStr(i + y + 1, s, cFnd)
        Loop
    End With
End Sub

Sub Highlight()
    Application.ScreenUpdating = False
    Dim Rng As Range
    Dim cFnd As String

    cFnd = InputBox("Search for?") 'so I could test without setting up the combobox
    For Each Rng In Selection
        HighlightCell Rng, cFnd
    Next Rng
    Application.ScreenUpdating = True
End Sub

以下屏幕截图显示了在选择A1:B2时运行代码的结果，其中搜索字词为cat。请注意，它是敏感的：

究竟为什么你的潜水员按原样行事，我不知道。毫无疑问，它与您正在搜索的字符串分开的方式有关，而不是直接找到它。

您可以考虑使用Find method更有效地定位相关单元格，但上面的代码应该可以解决您遇到的错误。

Answer 2

我觉得我真傻。我最初的工作。我在其他专栏中获得奇怪填充的原因是因为每当我进行新搜索时我都没有清除文本格式。当我改变它，它修复了一切。

突出显示在VBA中搜索的Word

2 个答案: