Suche Funktion "Excel" Makierung

[Liveplay]

Guten Tag,

Ich brauche Eure Hilfe und zwar, möchte ich mittels Visuel Basic Application in Excel eine Routine schreiben. Diese soll ein Begriff in einem Textfeld suchen und farbig hinterlegen.

+ Eingabe erfolgt über ein generiertes Suchfeld/Textfeld.
+ Suche erfolgt mit dem eingebene Suchbegriff in den Spalten & Zeilen die definiert sind.

+ Es soll ein bestimmter Bereich nur durchsucht werden bzw. Spalten. Das ganze mit einer Schleife die maximal 10 x durchläuft und dann ein Is nothing Then setzt mit End Sub.

+ Wenn ich das Suchwort aus dem Textfeld entferne soll die evtl. farbige Makierung aufgehoben werden.


+ Die Suche soll Leezeichen berücksichtigen und evtl. dazu addieren.

Ist das möglich ?

Die Makierung habe ich fertig eigentlich alles nur das es nur mit einer Spalte funktioniert , aber ich möchte das alle Spalten durchsucht werden.

Mein aktueller Code:

Sub search_Change()

    Dim strWert As String
    Dim strSuche As String        ' Danach wird gesucht
    Dim rngFound As Range ' hier wurde es gefunden
    Dim rngFound1 As Range
    Dim strFirstAddress As String ' die Adresse der 1. Fundstelle
    Dim strNextAddress As String ' die Adresse der nächsten Fundstelle
    'Dim strFirstAddress1 As String ' die Adresse der 1. Fundstelle
    'Dim strNextAddress1 As String ' die Adresse der nächsten Fundstelle
    
    Dim zeile As Variant
    Dim wzeile As Variant
    Dim i As Integer 'Anzahl der Datensätze in Tabelle "Fxxxx"
    
    strWert = Tabelle1.search
    strWert = Replace(strWert, " ", "") 'ggf. Leerzeichen entfernen
    strSuche = strWert
    
    ' After ans Ende stellen, damit die 1. Zelle von oben auch sicher gefunden wird
    ' Suchen in Spalte E (=5) in Werten, gesamten Zellinhalt vergleichen
    Set rngFound = Columns(4).Find(What:=strSuche, After:=Cells(Rows.Count, 4), LookIn:=xlValues, LookAt:=xlWhole)
    
    'Wenn Eingabe nicht vorhanden...
    If rngFound Is Nothing Then
        Exit Sub
    End If
       
       

    If Tabelle1.search <> "" Then
    'Eingabe vorhanden...
    ' 1. Fundstelle merken fürs Abbrechen merken um FindNext abzubrechen
    strFirstAddress = rngFound.Address
    
    Do
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(0, 154, 205)
        Cells(wzeile(2), "AA") = "."
        'Cells(wzeile(2), "S") = frmMain.txtName
        'Cells(wzeile(2), "T") = frmMain.lblDatum
        
        'Weitersuchen
        Set rngFound = Columns(4).FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(0, 154, 205)
        
    Loop While rngFound.Address <> strFirstAddress
    End If
    'Tabelle1.lblStatus = "gefunden"
    '------------------------------------
    If Tabelle1.search = "" Then
       Set rngFound = Columns("AA").Find(What:=".", After:=Cells(Rows.Count, "AA"), LookIn:=xlValues, LookAt:=xlWhole)
        If rngFound Is Nothing Then
            Exit Sub
        End If
    strFirstAddress = rngFound.Address
    Do
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        Cells(wzeile(2), "AA") = "."
        
        'Weitersuchen
        Set rngFound = Columns("AA").FindNext(rngFound)
        wzeile = Split(rngFound.Address, "$")
        zeile = "B" & wzeile(2) & ":" & "G" & wzeile(2)
        Range(zeile).Interior.Color = RGB(255, 255, 255)
        Cells(wzeile(2), "AA") = "."
        
    Loop While rngFound.Address <> strFirstAddress
    
        
    End If
      
    
End Sub