String suchen und markieren
Joni
ich filter eine Liste mit Daten nach dem Inhalt einer Zelle. Es werden alle Zeilen angezeigt die in irgendeiner Zelle an irgendeiner Stelle des Strings den Wert aus der Suchzelle enthalten. Jetzt hätte ich gerne, dass der in den Daten gefundene String auch noch markiert wird (z. B. farblich, fett oder unterstrichen). Z. B. Suchbegriff ass liefert Wasser und Gasse
Wie kann ich das in VBA umsetzen? Das Ganze sollte dann in diesen Code integriert werden:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFirst As String
Dim lngColumn As Long
Dim rngUnion As Range
Dim rngFound As Range
Dim rngTMP As Range
Dim lngRow As Long
On Error GoTo Fin
'MsgBox Target.Address
Application.ScreenUpdating = False
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Cells(1, 2)) Is Nothing Then
If Trim(Target.Value) = "" Then Cells.EntireRow.Hidden = False: Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
lngRow = IIf(Len(Cells(Rows.Count, 1)), Rows.Count, _
Cells(Rows.Count, 1).End(xlUp).Row)
lngColumn = Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set rngTMP = Range(Cells(9, 1), Cells(lngRow, lngColumn))
Set rngFound = rngTMP.Find(Cells(1, 2).Text, _
After:=Range("A9"), LookIn:=xlValues, LookAt:=xlPart)
If Not rngFound Is Nothing Then
strFirst = rngFound.Address
Do
If Not rngUnion Is Nothing Then
Set rngUnion = Application.Union(rngUnion, _
Cells(rngFound.Row, 1)).EntireRow
Else
Set rngUnion = Cells(rngFound.Row, 1).EntireRow
End If
Set rngFound = rngTMP.FindNext(rngFound)
Loop While rngFound.Address strFirst
Else
Target.ClearContents
MsgBox "Nothing found!"
End If
Else
Exit Sub
End If
Application.Goto Range("B1")
If Not rngUnion Is Nothing Then
rngTMP.Rows.Hidden = True
rngUnion.Hidden = False
End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
Set rngUnion = Nothing
Set rngFound = Nothing
Set rngTMP = Nothing
Exit Sub
End Sub
Danke Gruß Joni