Mettre en surbrillance une recherche de Word dans VBA

Question

Je veux avoir un code qui mettra en évidence chaque mot qui a été recherché. J'ai déjà un code de ce type, sauf qu'après la ligne 30, tout commence à être souligné. Je vais ajouter des images pour plus de clarté. Je ne sais pas ce qui ne va pas avec mon code ou ce que je pourrais réparer.

Voici mon code.

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 

Ceci est le code de recherche pour amener les résultats de recherche à la page montrée dans les images.

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 

Merci!

Answer 1

Voici une approche qui fait ce que vous voulez faire, mais d'une manière un peu plus directe:

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 

La capture d'écran ci-dessous montre le résultat de l'exécution du code en A1:B2 est sélectionné, le terme de recherche est cat. Notez qu'il est le cas sensitve:

Exactement pourquoi votre sous a agi comme il était, je ne sais pas. Sans doute cela a quelque chose à voir avec la façon dont vous étiez en train de scinder la chaîne que vous cherchiez plutôt que de la trouver plus directement.

Vous pouvez utiliser le Find method pour localiser les cellules pertinentes encore plus efficacement, mais le code ci-dessus devrait corriger le bug que vous rencontrez.

Answer 2

Eh bien, je me sens vraiment bête. Ce que j'avais travaillé à l'origine. La raison pour laquelle je recevais les remplissages bizarres dans d'autres colonnes était parce que je n'effaçais pas le format de texte chaque fois que je ferais une nouvelle recherche. Quand j'ai changé ça, ça a tout arrangé.