Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA: Filterkriterien dynamisch und ranglsite dazu

VBA: Filterkriterien dynamisch und ranglsite dazu
15.05.2017 16:14:42
Peter
Hallo zusammen,
bin mit meinem Latein (VBA-)Fähigkeiten am Limit angelangt.
Mit nachfolgendem Auszug erstelle ich pro Filterkriterium (bisher 3) eine Rangliste in Spalte AD (31) über die Vorjahresumsätze. Jetzt stehe ich aber vor dem Problem, dass die Gebiete (Filterkriterien) ausgeweitet werden und ich daher diesen Bereich "dynamisch" gestalten möchte, d.h. die Anzahl an Kriterien kann variieren und da ich diese im Vorfeld nicht kenne, sollte über VBA die Abfrage so gestaltet sein, dass alle berücksichtigt werden und jeweils die Rangliste genau für diesen gefilterten Bereich erstellt wird.
Geht so etwas überhaupt ?
Wäre schön, wenn mich dabei jemand unterstützen könnte.
Danke schon mal im voraus.
Gruß Peter

Sub Sortieren_Erstellen_PDF()
' Sortieren Makro und Speichern PDF
Dim Zeile As Long
Dim vntFile As Variant
Sheets("Umsatzaufstellung").Select
Range("A4").Select
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row      'letzte Zeile erkennen
'      MsgBox "Letzte Zeilennummer für Sortiment:  " & lz
Range(Selection, Selection.End(xlDown)).Select
Range("A4", "AZ" & lz).Select
ActiveSheet.Range("$A$4", "AZ" & lz).AutoFilter Field:=8, Criteria1:="Süd"   'nach Gebiet  _
filtern
Range("A4").Select
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row                'letzte Zeile  _
erkennen
'  MsgBox "Letzte Zeilennummer für Gebiet Mitte:  " & lz
Zeile = ActiveCell.Row                         'nächste Zeile in Filter finden
With ActiveSheet
Do
Zeile = Zeile + 1
Loop Until Rows(Zeile).Hidden = False
Cells(Zeile, 1).Select
End With
MsgBox "1. relevante Zeile für das Gebiet:  " & Zeile
' ab hier Formel für Rang
Range("AD" & Zeile).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[1],R" & Zeile & "C31:R" & lz & "C31)"           ' _
variable Formel für Rangliste
Application.CutCopyMode = False
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AD" & Zeile).Select
Selection.Copy
Range("AD" & Zeile, "AD" & lz).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$A$4", "AZ" & lz).AutoFilter Field:=8, Criteria1:="Nord"   '2. Gebiet  _
filtern
Range("A4").Select
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row                'letzte Zeile  _
erkennen
'  MsgBox "Letzte Zeilennummer für Gebiet Nord:  " & lz
Zeile = ActiveCell.Row                         'nächste Zeile in Filter finden
With ActiveSheet
Do
Zeile = Zeile + 1
Loop Until Rows(Zeile).Hidden = False
Cells(Zeile, 1).Select
End With
'  MsgBox "1. relevante Zeile für das Gebiet:  " & Zeile
' ab hier Formel für Rang
Range("AD" & Zeile).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[1],R" & Zeile & "C31:R" & lz & "C31)"           ' _
variable Formel für Rangliste
Application.CutCopyMode = False
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AD" & Zeile).Select
Selection.Copy
Range("AD" & Zeile, "AD" & lz).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
ActiveSheet.Range("$A$4", "BI" & lz).AutoFilter Field:=8, Criteria1:="Sonstige"   '3. Gebiet   _
_
_
_
filtern
Range("A4").Select
lz = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row                'letzte Zeile  _
erkennen
' MsgBox "Letzte Zeilennummer für Gebiet Ost:  " & lz
Zeile = ActiveCell.Row                                                     'nächste Zeile    _
_
_
_
in Filter finden
With ActiveSheet
Do
Zeile = Zeile + 1
Loop Until Rows(Zeile).Hidden = False
Cells(Zeile, 1).Select
End With
' ab hier Formel für Rang
Range("AD" & Zeile).Select
ActiveCell.FormulaR1C1 = "=RANK(RC[1],R" & Zeile & "C31:R" & lz & "C31)"           ' _
variable Formel für Rangliste
Application.CutCopyMode = False
Selection.NumberFormat = "0"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("AD" & Zeile).Select
Selection.Copy
Range("AD" & Zeile, "AD" & lz).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A2").Select
ActiveSheet.Range("$A$4:$AI$599").AutoFilter Field:=8
Range("A5").Select
Application.ScreenUpdating = True
End
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA: Filterkriterien dynamisch und ranglsite dazu
16.05.2017 13:30:45
Peter
Hallo Namensvetter,
Dein Problem lässt sich mit dem Spezialfilter lösen. In Excel2007 "Daten" - "Filtern/Erweitert". Ein Makro dazu lässt sich leicht durch Aufzeichnung erstellen. Grundlagen wären:
1) Ein Datenblock mit Überschriften, aus welchem gefiltert wird.
2) Die Überschriften entsprechen dem sog. "Kriterienbereich", hierfür eine eigene Zeile -
am besten auf einem weiteren neuen Arbeitsblatt - einrichten.
3) Den Ausgabebereich festlegen. Dieser wird dann nach Durchführung der Filterung z. B.
nach der Umsatzspalte sortiert.
Es gibt z. B. in dem Datenblock die Spalte "Gebiet". Wenn Du dann in dem Kriterienbereich in der Spalte "Gebiet" z. B. "Nord" eingibst, wird nach Anstoss des Filtermakros im Ausgabebereich nur "Nord" ausgegeben und sortiert. Man kann auch mehrere Kriterien vorsehen. In diesem Fall bitte den "Kriterienbereich" auf 3 oder mehr Zeilen erweitern. Eingabe in der Spalte "Gebiet" z. B. "Nord" und "West".
Mit freundlichem Gruß
Peter Kloßek
Anzeige

281 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige