Zeilen mehrfach nach Einträgen filtern
Joni
ich möchte aus einer Liste Daten heraus filtern. Dabei hilft mir das Makro von Klaus aus meiner vorigen Frage
https://www.herber.de/forum/messages/1179259.html
Zusätzlich möchte ich die gefundenen Zeilen mit meinem ursprünglichen Makro noch filtern. Dann könnte ich zuerst alle Zeilen anzeigen lassen in denen der globale Suchbegriff vorkommt und anschließend das Ergebnis über eine einzelne Spalte noch weiter einschränken.
Jetzt sollte ich die beiden worksheet change Ereignisse abarbeiten können. Es ist aber keine entweder oder Funktion sondern die Gesamtsuche soll immer das Hauptergebnis liefern und die Spaltensuche sollte dann die Gesamtsuche ggfl. noch weiter einschränken. Wie muss ich die beiden Codes verbinden?
Zusätzlich wäre es noch super, wenn der String aus der Gesamtsuche überall wo er gefunden wird auch farblich gekennzeichnet wird. Die Kennzeichnung sollte vor der nächsten Suche natürlich zurückgesetzt werden.
Danke für euer Hilfe.
Gruß Joni
Hier der Code bei dem der 2. Teil einfach ignoriert wird:
Private Sub Worksheet_Change(ByVal Target As Range)
'Teil 1 => Gesamtsuche nach einem Begriff in allen Spalten und egal an welcher Stelle im String
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
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
'Teile 2 => Spaltensuche für weitere Einschränkung; gesucht wird nur in der Spalte und immer _
vom Beginn des Strings
If Target.Row = 3 Then
Cells(8, 1).CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=Range(Cells(3, 1), Cells(4, Columns.Count).End(xlToLeft)), Unique:= _
False
End If
End Sub