Ziel dieses Scriptes

Mit Hilfe dieses Scriptes können Sie nach einem bestimmten Text in Zellen suchen und den gefundenen Text farbig hervorheben. In eine Eingabebox geben Sie den zu suchenden Text ein. Nach der Suche wird eine entsprechende Meldung ausgegeben.

Das Script wurde in die Standard-Prozedur einer Tabelle eingegeben „Worksheet_BeforeDoubleClick“. Klicken sie doppelt in die verwendete Tabelle, wird der eigentliche Doppelklick deaktiviert (Cancel = True) und anschließend das Script ausgeführt.

Folgende Dinge sollte man bei Anwendung des Scriptes berücksichtigen:

• Dieses Script prüft nicht, ob die Tabelle schreibgeschützt ist
• Die While-Wend-Schleife setzt voraus, dass sich alle zu prüfenden Zellen (hier in Spalte 1) unmittelbar untereinander befinden, ohne Leerzeilen
• In einer While-Wend-Schleife sollte immer ein Zähler (hier: Zeile = Zeile + 1) verwendet werden, ansonsten läuft die Schleife immer in der gleichen Zeile, also endlos!
• Trifft die While-Wend-Schleife auf eine leere Zeile, bricht sie die Ausführung des Scriptes ab. Sie funktioniert nur solange, solange sich in der aktuellen Zeile (Zelle…) Inhalt befindet (Cells(Zeile, Spalte).Value <> "")

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    'Den "Doppelklick" deaktivieren
    Cancel = True
    'Variablen festlegen
    Dim Eingabe As String, Inhalt As String
    Dim Anfang As Integer, Laenge As Integer
    Dim Zeile As Integer, Spalte As Integer
    Dim g As Boolean, n As Integer
    
    'Die Eingabebox festlegen
    Eingabe = InputBox("Geben Sie hier den zu suchenden Text ein," & vbCrLf _
    & "der farbig markiert werden soll:", "Geben Sie den zu suchenden Text ein:", "Test")
    
    'Prüfen ob "Abbrechen" angelickt wurde, oder "OK" jedoch ohne Eingabe
    If Len(Eingabe) = 0 Then
        'Wenn keine Eingabe erfolgt ist, dann Prozedur verlassen
        '(Die Eingabe von "nur Leerzeichen" kann mit Trim(Eingabe) abgefangen werden)
        Exit Sub
    Else
        Application.Screenupate = False
        'Zellen in Spalte A: in Schriftfarbe "schwarz" und ohne Fett-Schrift formatieren,
        'falls vorher eine Suche druchgeführt wurde
        With Columns("A:A").Font
            .Color = RGB(0, 0, 0) 'RGB(0, 0, 0) = schwarz
            'oder falls Schriftfarbe in Standard formatiert werden soll:
            '.ColorIndex = xlAutomatic
            '.TintAndShade = 0
            'Fettschrift ausschalten:
            .Bold = False
        End With
        'Variablen initialisieren
        Zeile = 1
        Spalte = 1
        n = 0 'n = Zähler
        While Cells(Zeile, Spalte).Value <> "" 'Schleife solange ausführen,
            'solange Text in einer Zelle gefunden wird. Bei Leerzeilen stopt das Script.
            Inhalt = Cells(Zeile, Spalte).Value
            If InStr(1, Inhalt, Eingabe) > 0 Then
                g = True 'g bleibt = false, solange der Suchtext nicht gefunden wurde
                n = n + 1 'Fundstellen zählen
                'Erster Buchstabe des gefundenen Textes
                Anfang = InStr(1, Inhalt, Eingabe, vbTextCompare)
                'Anzahl der Buchstaben, die formatiert werden sollen
                Laenge = Len(Eingabe)
                'Den gefundenen Text in der Zelle farbig (rot, fett) hervorheben
                With Cells(Zeile, Spalte).Characters(Start:=Anfang, Length:=Laenge).Font
                    .Color = RGB(255, 0, 0) '= rot
                    .Bold = True 'Fett-Schrift ein
                End With
            End If
        'Eine Zeile weiterzählen
        Zeile = Zeile + 1
        Wend
        Application.Screenupate = True
        'Eine entsprechende Meldung ausgeben
        If g = False Then
            MsgBox "Der Suchtext """ & Eingabe & """ konnte nicht gefunden werden.", vbExclamation, "Ergebnis:"
        Else
            MsgBox "Der Suchtext """ & Eingabe & """ wurde " & n & "x gefunden.", vbInformation, "Ergebnis:"
        End If
    End If
End Sub

Nach dem Abarbeiten des Scriptes wird eine Meldung ausgegeben:

Ich freue mich über Meinungen, Ideen oder Kritik… schreiben Sie mir eine E-Mail »