Probleme viele Argumente beim Spezialfilter
17.10.2008 08:06:00
Susi
ich habe eine kleines Problem mit dem Spezialfilter. Meine Tabelle ist so aufgebaut, dass ich zwei TB mit Grunddaten und zwei TB mit den jeweiligen Ergebnissen des Spezialfilters habe. Die Auswahl treffe ich auf einem TB mit Auswahlfeldern.
Zum Testen habe ich es erst einmal mit einem Makro und zwei Argumenten ausprobiert. Da hat auch noch alles wunderbar funktioniert.
Makro 1:
Private Sub Filter_anwenden_Click()
Application.ScreenUpdating = False
Worksheets("Ergebnis A").Select
If Worksheets("Ergebnis A").Range("B5") = "B" Then
Worksheets("Ergebnis B").Select
Sheets("Tabelle1").Range("A1:S5000").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis B").Range("B4:B5"), CopyToRange:=Sheets(" _
Ergebnis B").Range("A9:B5000") _
, Unique:=True
Else
Worksheets("Ergebnis A").Select
Sheets("Projekte").Range("A12:L2656").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis A").Range("B4:B5"), CopyToRange:=Sheets(" _
Ergebnis A").Range("A10:F5000") _
, Unique:=True
End If
Application.ScreenUpdating = True
End Sub
Dieses Makro läuft einwandfrei durch.
Da ich aber viele Argumente zur Auswahl habe, wollte ich nun das Makro aufbohren, nach dem Motto Wenn Argument 1 dann Auswahl 1, wenn Argument 2 dann Auswahl 2, wenn Argument 3 dann Auswahl 3 u.s.w..
Leider bekomme ich nicht die richtige Syntax hin. Hier mein Versuch.
Makro 2:
Private Sub Filter_anwenden_Click()
Application.ScreenUpdating = False
Worksheets("Ergebnis A").Select
'ALLE PROJEKTE
If Worksheets("Ergebnis A").Range("B5") = "ALLE PROJEKTE" Then
Worksheets("Ergebnis A").Select
Sheets("Projekte").Range("A12:L2656").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis A").Range("B4:B4"), CopyToRange:=Sheets(" _
Ergebnis A").Range("A10:F5000") _
, Unique:=True
End If
'Beschaffungen
If Worksheets("Ergebnis A").Range("B5") = "B" Then
Worksheets("Ergebnis B").Select
Sheets("Tabelle1").Range("A1:S5000").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis B").Range("B4:B5"), CopyToRange:=Sheets(" _
Ergebnis B").Range("A9:B5000") _
, Unique:=True
End If
'F-Beschaffungen
If Worksheets("Ergebnis A").Range("B5") = "F" Then
Worksheets("Ergebnis B").Select
Sheets("Tabelle1").Range("A1:S5000").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis B").Range("B4:B5"), CopyToRange:=Sheets(" _
Ergebnis B").Range("A9:B5000") _
, Unique:=True
End If
'historisch
Worksheets("Ergebnis A").Select
Sheets("Projekte").Range("A12:L2656").AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=Sheets("Ergebnis A").Range("B4:B5"), CopyToRange:=Sheets(" _
Ergebnis A").Range("A10:F5000") _
, Unique:=True
Application.ScreenUpdating = True
End Sub
Das Zweite Makro läuft zwar auch durch, aber es kommt leider nur Murks raus. Ich muss insgesamt ca. 7 If ... then Else Argumente hinzufügen.
Vielleicht kann mir ja einer helfen, wie ich das Makro aufbauen müsste, um immer je nach Argument eine Lösung (Filterung) auf meinen zwei Ergebnis-Tabellenblättern zu erhalten.
Vielen Dank schon mal.
Gruß Susi