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
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.
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:
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")
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
Hallo,
(03.06.2020, 10: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
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
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 :)