Hallo ich habe folgenden Code mit der Suchfunktion schon erstellt. Jetzt habe ich mehrere Probleme.
1. Wenn ich Spalten ausblenden wird auch die Zelle in der ich die Suche eingebe ausgeblendet. => ich würde das gerne durch ein Textfeld ersetzen und weiß nicht wie ich den Code dafür verändere bzw. bei mir funktioniert das nicht.
2. Bisher ist es so, dass die Zelle "Suchkriterium" wo ich den Suchbegriff eingebe auch mit Gelb färbt, dass Format der Zelle bzw. dann Textfeld soll aber beibehalten werden.
3. Und es wäre schon wenn man mehrere Suchbegriffe suchen könnte. Z.B Begriff1, Begriff2 und wenn beide in einer Zeile/Zelle vorkommen, dass diese dann markiert bzw. gefiltert wird.
Hier der Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Suchkriterium")) Is Nothing Then Call SucheUndMarkiereUIDPCR
End Sub
Code des Moduls:
Dim markierteZellen As Range
Sub SucheUndMarkiereUIDPCR()
' Überprüfen, ob das Suchkriterium leer ist
If Trim(Range("Suchkriterium").Value) = "" Then
' Wenn das Suchkriterium leer ist, alle Zeilen der Tabelle anzeigen
ActiveSheet.ShowAllData
' Vor dem Zurücksetzen überprüfen, ob es zuvor markierte Zellen gibt
If Not markierteZellen Is Nothing Then
ResetMarkierungen
End If
Else
' Vor dem Filtern alle zuvor markierten Zellen zurücksetzen
ResetMarkierungen
' Wenn das Suchkriterium nicht leer ist, Werte für den Filter eintragen
shFilter.Range("A2, B3, C4, D5, E6").Value = "*" & Range("Suchkriterium").Value & "*"
' Erweiterten Filter anwenden
Range("tbluidpcr[#All]").AdvancedFilter xlFilterInPlace, shFilter.Range("A1:E6")
' Suchbegriff markieren
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim searchTerm As String
' Ziel-Arbeitsblatt setzen
Set ws = ActiveSheet
' Suchbegriff setzen
searchTerm = Range("Suchkriterium").Value
' Gesamten Bereich der Tabelle durchsuchen
Set rng = ws.UsedRange
For Each cell In rng
If InStr(1, cell.Value, searchTerm, vbTextCompare) > 0 Then
' Zelle mit dem Suchbegriff hervorheben
cell.Interior.Color = RGB(255, 255, 0) ' Ändere die RGB-Werte nach Bedarf
' Markierte Zellen zur Liste hinzufügen
If markierteZellen Is Nothing Then
Set markierteZellen = cell
Else
Set markierteZellen = Union(markierteZellen, cell)
End If
End If
Next cell
' Überprüfen, ob es zuvor markierte Zellen gibt
If Not markierteZellen Is Nothing Then
' Zellen, die nach dem Filtern nicht mehr dem Suchkriterium entsprechen, zurücksetzen
For Each cell In markierteZellen
If InStr(1, cell.Value, searchTerm, vbTextCompare) = 0 Then
cell.Interior.ColorIndex = xlNone
End If
Next cell
End If
End If
End Sub
Sub ResetMarkierungen()
' Überprüfen, ob zuvor markierte Zellen vorhanden sind
If Not markierteZellen Is Nothing Then
' Hintergrundfarbe der zuvor markierten Zellen zurücksetzen
markierteZellen.Interior.ColorIndex = xlNone
' Liste der markierten Zellen löschen
Set markierteZellen = Nothing
End If
End Sub
|