Thema Datum  Von Nutzer Rating
Antwort
Rot Suchfunktion mit Excel VBA anpassen
19.01.2024 08:57:59 Jamie99
NotSolved
19.01.2024 21:05:49 ralf_b
NotSolved

Ansicht des Beitrags:
Von:
Jamie99
Datum:
19.01.2024 08:57:59
Views:
509
Rating: Antwort:
  Ja
Thema:
Suchfunktion mit Excel VBA anpassen

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
 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Suchfunktion mit Excel VBA anpassen
19.01.2024 08:57:59 Jamie99
NotSolved
19.01.2024 21:05:49 ralf_b
NotSolved