VBA Autofilter

[llleeefffttt]

Hallo,

ich möchte per VBA meine Zeilen Filtern, dies klappt bereits wunderbar mit folgendem Code... es öffnet sich ein Eingabefeld, indem ich den Suchbegriff eingeben kann.
Finden tut er was, aber leider nur wenn ich den gesamten Suchbegriff eingebe.

Ziel ist es die Ergebnisse auch anzuzeigen, wenn nur ein Teil des Suchbegriffes enthalten ist.

Bsp.:

In z.b. Zelle A1  steht "hallo Herr Müller wie geht es Ihnen" , wenn ich jetzt "Herr" in die Suche eingebe, soll diese Zeile gefunden und angezeigt werden.

Würde mich über eine Hilfe freuen.

Code:

Sub FilterealleSpalten()

Dim Suchbegriff As String
Dim rngFilter As Range

Suchbegriff = Application.InputBox("Suchbegriff eingeben" & Chr(13) & Chr(13) & "(Mit dieser Suche wird auf allen Spalten gesucht und gefiltert)")

With ActiveSheet
 Set rngFilter = Intersect(.Range("$A$1:$F$" & .Rows.Count), .UsedRange)

 With Intersect(rngFilter.EntireRow, .Columns("L"))
   .Formula = "=Countif(" & rngFilter.Rows(1).Address(0, 0) & ", """ & Suchbegriff & """)"
   If ActiveSheet.FilterMode Then .AutoFilter
   .AutoFilter Field:=1, Criteria1:=">0"
 End With

End With

[RPP63]

Moin!
Asterisk (*) heißt das Zauberwort:

Code:

Suchbegriff = "*" & Application.InputBox("Suchbegriff eingeben" & Chr(13) & Chr(13) & _
   "(Mit dieser Suche wird auf allen Spalten gesucht und gefiltert)") & "*"

Gruß Ralf

[llleeefffttt]

Wow, :D  Danke!

Anscheinend merkt sich das Programm die Suche, und blendet alle Zeilen aus in denen der Suchbegriff nicht vorhanden ist, nimmt bei einer neuen Suche dann nur die Sichtbaren, und blendet den rest wieder aus... usw

Gibt es eine Möglichkeit das zu unterbinden


Hoffe das war verständlich ;)

[RPP63]

Nach Set rngFilter = 

Code:

If AutoFilterMode Then rngFilter.AutoFilter

Gruß Ralf

[llleeefffttt]

Hallo,

leider kann ich das nicht in den Code einsetzten er hinterlegt es rot, liegt wohl an dem if then Befehl?

Sry bekomms nicht hin

[RPP63]

Ich hoffe mal, Du hast nach nicht mit neben/hinter übersetzt?
Nach heißt hier natürlich: in neuer Zeile darunter.

Da Du Dich ohnehin in einer With-Klammer befindest, setze noch einen Punkt davor:

Code:

If .AutoFilterMode Then rngFilter.AutoFilter

Gruß Ralf

[llleeefffttt]

Hallo Ralf, danke das du dir die Zeit nimmst :)

Habe es eingefügt wie von der gesagt, erhalte leider den Laufzeitfehler 1004 ohne Punkt und mit Punkt den Error 400

Code:

Option Explicit
Sub FilterealleSpalten()

Dim Suchbegriff As String
Dim rngFilter As Range

Suchbegriff = "*" & Application.InputBox("Suchbegriff eingeben" & Chr(13) & Chr(13) & "(Mit dieser Suche wird auf allen Spalten gesucht und gefiltert)") & "*"

With ActiveSheet
 Set rngFilter = Intersect(.Range("$A$1:$F$" & .Rows.Count), .UsedRange)
   If .AutoFilterMode Then rngFilter.AutoFilter

 With Intersect(rngFilter.EntireRow, .Columns("L"))
   .Formula = "=Countif(" & rngFilter.Rows(1).Address(0, 0) & ", """ & Suchbegriff & """)"
   If ActiveSheet.FilterMode Then .AutoFilter
   .AutoFilter Field:=1, Criteria1:=">0"
 End With
End With

Set rngFilter = Nothing


End Sub

[RPP63]

Lade doch mal die (anonymisierte) Datei hoch, dann kann man am offenen Herzen operieren.
Meine Snippets sind logischerweise ungetestet.

Gruß Ralf

[llleeefffttt]

There you go :)

Der code wird über den Suchen Button ausgführt

[atilla]

Hallo,

teste so:

Code:

Sub FilterealleSpalten()

Dim Suchbegriff 'nicht als String deklarieren!!!
Dim rngFilter As Range

Suchbegriff = Application.InputBox("Suchbegriff eingeben" & Chr(13) & Chr(13) & "(Mit dieser Suche wird auf allen Spalten gesucht und gefiltert)")

If Suchbegriff <> False And Suchbegriff <> "" Then 'nur wenn etwas eingegeben  und nicht abbrechen gedrückt wurde
 Application.ScreenUpdating = False
 With ActiveSheet
   If .AutoFilterMode Then If .FilterMode Then .ShowAllData
   Set rngFilter = Intersect(.Range("$A$1:$F$" & .Rows.Count), .UsedRange)
   With Intersect(rngFilter.EntireRow, .Columns("L"))
     .Formula = "=Countif(" & rngFilter.Rows(1).Address(0, 0) & ", ""*" & Suchbegriff & "*"")"
     .AutoFilter Field:=1, Criteria1:=">0"
   End With
 End With
 Application.ScreenUpdating = True
End If
Set rngFilter = Nothing

End Sub