Auto-Filter mit Makro

Computer: Software & Programmierung Office Software
1

Hallo Excel-Experten!

Ich habe versucht, einen benutzerdefinierten Auto-Filter mit Makro aufzuzeichnen. Leider ohne Erfolg. Diese Codezeilen hat der Makro-Rekorder bereits produziert:
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter
Damit schaffe ich es, den verwendeten Bereich zu markieren, wenn ich die Überschriftenzeile markiere. Ich sollte aber so weit kommen, dass ich (bei Cursorposition) in der Tabelle per Makro einen benutzerdefinierten Autofilter produziere, in dem der Benutzer die Kriterien selbst auswählt. Ich habe schon probiert, diesen benutzerdefinierten Autofilter aufzuzeichnen, allerdings muss ich ihm auch Kriterien eingeben, bevor ich ihn ausführen kann. (Das soll dann eben der Benutzer selbstständig können!!)

Danke für die Hilfe und Gruß Alex

2

Hallo Alex,

leider kann man Dialog für das benutzerdefinierte Filter nicht via

 Application.Dialogs(xlDialogXXXXX).Show

als eingebauten EXCEL-Dialog per VBA aufrufen -zumindest nicht unter EXCEL97.

Zur Eingabe der Filterkriteriun müsste man ein Userform kreieren, dass den EXCEL-Dialog nachbildet. Die Eingaben im Userform muss man dann auswerten, um dem Autofilterkommando die entsprechenden Variablen zu übergeben.
Als Makro schaut das Ganze dann etwa so aus:
Makros für Userform:

Private Sub CommandButton1\_Click() 'Abbruch
 Me.Hide
 Abbruch = True
End Sub

Private Sub CommandButton2\_Click() 'OK
 Abbruch = False
 Me.Hide
End Sub

Private Sub UserForm\_Initialize()
 ' ComboBox1 = Auswahlbox für Vergleichsoperator Kritrium 1
 ComboBox1.AddItem ""
 ComboBox1.AddItem "ist gleich"
 ComboBox1.AddItem "ist ungleich"
 ComboBox1.AddItem "ist kleiner als"
 ComboBox1.AddItem "ist kleiner oder gleich"
 ComboBox1.AddItem "ist größer als"
 ComboBox1.AddItem "ist größer oder gleich"
 ComboBox1.AddItem "beginnt mit"
 ComboBox1.AddItem "beginnt nicht mit"
 ComboBox1.AddItem "enthält"
 ComboBox1.AddItem "enthält nicht"
 ComboBox1.AddItem "endet mit"
 ComboBox1.AddItem "endet nicht mit"
 ' ComboBox2 = Auswahlbox für Vergleichsoperator Kritrium 2
 ComboBox2.AddItem ""
 ComboBox2.AddItem "ist gleich"
 ComboBox2.AddItem "ist ungleich"
 ComboBox2.AddItem "ist kleiner als"
 ComboBox2.AddItem "ist kleiner oder gleich"
 ComboBox2.AddItem "ist größer als"
 ComboBox2.AddItem "ist größer oder gleich"
 ComboBox2.AddItem "beginnt mit"
 ComboBox2.AddItem "beginnt nicht mit"
 ComboBox2.AddItem "enthält"
 ComboBox2.AddItem "enthält nicht"
 ComboBox2.AddItem "endet mit"
 ComboBox2.AddItem "endet nicht mit"
 TextBox1.Value = "" 'Suchtext Kriterium1
 TextBox2.Value = "" 'Suchtext Kriterium2
 OptionButton1.Value = False 'UND - Option
 OptionButton2.Value = False 'ODER - Option
End Sub

Code des Makros, das aus dem Tabellenblatt gestartet wird

Public Abbruch As Boolean
Sub Autofiltern()
 Dim Undoder As Integer, Kriterium1 As String, Kriterium2 As String
 Selection.AutoFilter 'Schaltet ggf. vorhandenes Autofilter ab
 Range(Selection, Selection.End(xlDown)).Select
 Selection.AutoFilter 'Schaltet ggf. vorhandenes Autofilter ab
 UserForm1.Show
 If Abbruch = True Then Exit Sub
 'Auswertung der Kriteriumseingaben im Userform
 If UserForm1.TextBox1.Value = "" Then
 MsgBox ("Für Kriterium1 wurde nichts eingegeben, Filter wird abgebrochen!")
 Exit Sub
 End If
 Kriterium1 = Kriterium(UserForm1.TextBox1.Value, UserForm1.ComboBox1.Value)
 If UserForm1.TextBox2.Value "" Then
 Kriterium2 = Kriterium(UserForm1.TextBox2.Value, UserForm1.ComboBox2.Value)
 End If
 ' Auswertung der Optionbuttons für Logikverknüpfung
 Undoder = 0
 If UserForm1.OptionButton1.Value = True Then Undoder = xlAnd
 If UserForm1.OptionButton2.Value = True Then Undoder = xlOr
 If Kriterium2 = "" Then Undoder = 0
 Select Case Undoder
 Case 0 'Ein Kriterium ist angegeben
 Selection.AutoFilter Field:=1, Criteria1:=Kriterium1
 Case xlOr, xlAnd 'Zwei Kriterien sind angegeben
 Selection.AutoFilter Field:=1, Criteria1:=Kriterium1, Operator:=Undoder, \_
 Criteria2:=Kriterium2
 End Select
End Sub

Function Kriterium(Suchtext As String, Operator As String) As String
' generiert den Kriterium Text für benutzerdefiniertes Autofilter
 Select Case Operator
 Case "ist gleich"
 Kriterium = "=" & Suchtext
 Case "ist ungleich"
 Kriterium = "" & Suchtext
 Case "ist kleiner als"
 Kriterium = "" & Suchtext
 Case "ist größer oder gleich"
 Kriterium = "\>=" & Suchtext
 Case "beginnt mit"
 Kriterium = "=" & Suchtext & "\*"
 Case "beginnt nicht mit"
 Kriterium = "" & Suchtext & "\*"
 Case "enthält"
 Kriterium = "=\*" & Suchtext & "\*"
 Case "enthält nicht"
 Kriterium = "\*" & Suchtext & "\*"
 Case "endet mit"
 Kriterium = "=\*" & Suchtext
 Case "endet nicht mit"
 Kriterium = "\*" & Suchtext
 Case Else
 Kriterium = ""
 End Select
End Function

In meinem Beispiel wird der Suchtext für die Kriterien in eine Textbox des Userforms geschrieben. Als Verfeinerung könnte man statt der Textboxen hier Comboboxen verwenden, die den Inhalt im selektierten Zellenbereich als Auswahl anbieten.

Gruß
Franz

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

3

Hallo Franz!

Danke für die bisherige Hilfe! Allerdings habe ich noch drei kleine Probleme:

  1. Excel bricht das Makro gleich ab. (Hinweis Objekt erforderlich! ) Vielleicht könnte es auch damit zusammenhängen, dass kein Bereich markiert ist…
  2. Bei der Combobox sind keine Inhalte vorhanden.
  3. Das Abschicken funktioniert auch noch nicht.

Danke für die weitere Hilfe! Ich habe besseren Lösung die Datei plus Makro an deine E-Mail-Adresse geschickt. (sicher virenfrei *gg*)

Gruß Alex