Erweiterter Filter mit VBA
#1
Hallo Community,
ich habe folgendes Problem, und zwar möchte ich ein Organigramm in Excel erstellen. Zuerst muss ich aber eine Liste nach Einträgen filtern, da alle Abteilungen in einer Liste zusammengefasst sind. Das ganze wollte ich gerne mit Makros machen.
Jetzt habe ich gleich am Anfang ein Problem und zwar lässt sich der erweiterte Filter aus irgendwelchen gründen nicht anwenden, also kann ich ihn nicht richtig mit dem Rekorder aufzeichnen.
Ich hätte gerne dass mir per Makro nach dem Wert sortiert wird der in einem Feld per Dropdown Menü ausgewählt wird ( das entspricht dann der Abteilung )
Das ist mein aktueller Code:
Code:
Sub ErweiterterFilter()
'
' ErweiterterFilter Makro
'
'
    Range("A1:F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1:F95").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
End Sub
Das filterkriterium steht z.B. in Zelle H1.
Ich verstehe die Syntax auch noch nicht so ganz, also wäre es lieb von euch wenn ihr mir vllt die Lösung etwas erklären könntet.
Danke für eure Hilfe :)
Excel
Top
#2
Hallo,

das Filterkriterium muss mindestens zwei Zellen umfassen, da dafür auch die Spaltenüberschrift der zu filternden Spalte benannt sein muss. Das müsste also etwa so aussehen:

Code:
Range("A1:A11").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("D1:D2"), Unique:=False

Wobei Range("A1:A11) in diesem Fall der zu filternde Bereich ist, Range("D1:D2") steht für den Kriterienbereich.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
Top
#3
Danke für die schnelle Antwort,
ich habe das jetzt mal in meinem Code umgesetzt:
Code:
Sub ErweiterterFilter()
'
' ErweiterterFilter Makro
'
'
    Range("A1:F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A1:F95").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("H2"), Unique:=False
End Sub


Wenn ich das Makro jetzt laufen lasse passiert aber leider immer noch nichts außer dass die Tabelle markiert wird.
Muss ich bei dem ersten Range die Spalte angeben in der gefiltert wird ? Weil ich wähle die ganze Tabelle aus. Ist da mein Fehler?
Also:
Top
#4
Hallo,

das ist falsch:


Zitat:CriteriaRange:=Range("H2")


der Kriterienbereich muss mindestens zwei Zellen umfassen, wobei in der oberen die Spaltenüberschrift des zu filternden Bereiches stehen muss und zwar in genau der gleichen Schreibweise, wie im Listenbereich. (Am besten dort kopieren). Das hatte ich in meiner ersten Antwort schon geschrieben. Also zum Beispiel:  CriteriaRange:=Range("H1:H2")
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
[-] Folgende(r) 1 Nutzer sagt Danke an Klaus-Dieter für diesen Beitrag:
  • ExcelFoley69
Top
#5
Vielen Dank, das funktioniert jetzt.
Zumindest hat es jetzt der Rekorder so aufgezeichnet.
Jetzt habe ich nur noch das Problem, dass es nur die Erste Spalte aus meinem Sheet raus löscht und sonst nichts macht wenn ich das Makro laufen lasse. Ich habe noch ergänzt, dass ich die gefilterten Daten gerne auf einem neuen Sheet hätte. Wenn ich die Schritte aber "per Hand" durchgehe während ich aufzeichne funktioniert es komischerweise.
Das ist mein Code
Code:
Sub Filtern()
'
' Filtern Makro
'
'
    Sheets("Abteilung").Range("A1:F95").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Abteilung").Range("J1:J2"), CopyToRange:=Range("A1") _
        , Unique:=False
End Sub
LG
Excel
Top
#6
Hallo,

wenn die gefilterten Daten auf einem Blatt sein sollen, musst du anders vorgehen. Das habe ich hier: Erweiterter Filter (Spezialfilter) beschrieben.
Viele Grüße
Klaus-Dieter
Der Erfolg hat viele Väter, 
der Misserfolg ist ein Waisenkind
Richard Cobden
[-] Folgende(r) 1 Nutzer sagt Danke an Klaus-Dieter für diesen Beitrag:
  • ExcelFoley69
Top
#7
Hallo,

(03.06.2020, 11:31)ExcelFoley69 schrieb: Ich habe noch ergänzt, dass ich die gefilterten Daten gerne auf einem neuen Sheet hätte.
Sub Filtern()
    Sheets("Abteilung").Range("A1:F95").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Abteilung").Range("J1:J2"), CopyToRange:=Sheets("BlaBla").Range("A1") _
        , Unique:=False
End Sub
Gruß Uwe
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • ExcelFoley69
Top
#8
Danke alles funktioniert,
wäre es jetzt noch möglich diese Hilfstabelle nach einer von mir definierten Hierarchie zu ordnen ? Da ich ja am Ende ein Organigramm erstellen möchte. Sprich die Personen mit der Position PL( für Projektleiter) ganz oben und dann jeweils die nächsten Positionen z.B. MIT für Mitarbeiter.
LG
Excel Blush
Top
#9
Habe mein Problem selbst gelöst, falls jemand das selbe Problem hat.
Code:
    ActiveWorkbook.Worksheets("Hilfstabelle").Sort.SortFields.Add Key:=Range( _
        "B2:B200"), SortOn:=xlSortOnValues, CustomOrder:="PL, CE, SysFo, E/E TPL", DataOption:= _
        xlSortNormal
Bei Custom Order habe ich mir meine Reihenfolge definiert.
Vielen Dank für eure Hilfe :)
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste