Recherche dynamique avec surbrillance - Excel VBA

Question

J'aimerais obtenir les résultats suivants: Dans ma feuille Excel, j'ai un ensemble de données auxquelles j'ai appliqué le filtrage dynamique en créant une «zone de recherche». Le filtrage lui-même fonctionne bien, pas de problèmes là-bas, cependant, je voudrais encore l'améliorer, en mettant en évidence le texte (qui est entré dans la boîte de recherche) dans les lignes filtrées en rouge. Je joins une capture d'écran de ce que j'aimerais voir dans la version finale.

Toute idée de comment cela peut être entré dans mon code actuel?

Comme toujours, toute aide est grandement appréciée! Merci!

est en dessous du code que j'utilise pour le filtrage dynamique:

Private Sub TextBox1_Change() 
Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 


If Len(TextBox1.Value) = 0 Then 
    Sheet1.AutoFilterMode = False 
Else 
    If Sheet1.AutoFilterMode = True Then 
     Sheet1.AutoFilterMode = False 
     End If 

    Sheet1.Range("B4:C" & Rows.Count).AutoFilter field:=1, Criteria1:="*" & TextBox1.Value & "*" 

    End If 

Application.ScreenUpdating = True 
Application.Calculation = xlCalculationAutomatic 
End Sub 

Answer 1

Tenir compte quelque chose comme ça - Ecrire dans une feuille de calcul comme suit:

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    If Target.Count > 1 Then Exit Sub 
    If Target <> Range("a1") Then Exit Sub 
    SelectAndChange (Target) 

End Sub 

Private Sub SelectAndChange(strValue As String) 

    Dim rngCell  As Range 
    Dim rngRange As Range 
    Dim strLookFor As String 
    Dim arrChar  As Variant 
    Dim lngCounter As Long 

    If strValue = vbNullString Then Exit Sub 

    Application.EnableEvents = False 

    Set rngRange = Range("E1:E10") 
    rngRange.Font.Color = vbBlack 
    strLookFor = Range("A1").Value 

    For Each rngCell In rngRange 
     For lngCounter = 1 To Len(rngCell) - Len(strLookFor) + 1 
      If Mid(rngCell, lngCounter, Len(strLookFor)) = strLookFor Then 
       rngCell.Characters(lngCounter, Len(strLookFor)).Font.Color = vbRed 
      End If 
     Next lngCounter 
    Next rngCell 

    Application.EnableEvents = True 

End Sub 

Les valeurs E1:E10 dépendrait de la valeur dans A1 comme ceci: