Wiederholtes Datenfiltern vereinfachen

Forumthread: Wiederholtes Datenfiltern vereinfachen

Das

Guten Morgen,
ich bräuchte noch einmal eure Hilfe. Aus einer Datenbank filtere ich Daten und speicher sie in bestimmte Bereiche. Da der Vorgang sich wiederholt und sich nur die Kriterien und er Zielbereich ändert, müsste man den Code doch bestimmt vereinfachen können.
Es muss sich jetzt niemand die Mühe machen und mir den kompletten Code umschreiben, es genügt mir, wenn ich einen Vorschlage mit den ersten 2 bis 3 Datenfiltern bekomme.

Sub DBfiltern()
With ActiveSheet.Range("o1:w1000")
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l4:m5"), CopyToRange:=Range("z1"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l6:m7"), CopyToRange:=Range("z11"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l9:m10"), CopyToRange:=Range("z21"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l11:m12"), CopyToRange:=Range("z31"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l14:m15"), CopyToRange:=Range("z41"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l16:m17"), CopyToRange:=Range("z51"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l19:m20"), CopyToRange:=Range("z61"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l21:m22"), CopyToRange:=Range("z71"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l24:m25"), CopyToRange:=Range("z81"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l26:m27"), CopyToRange:=Range("z91"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l29:m30"), CopyToRange:=Range("z101"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l31:m32"), CopyToRange:=Range("z111"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l34:m35"), CopyToRange:=Range("z121"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l36:m37"), CopyToRange:=Range("z131"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l39:m40"), CopyToRange:=Range("z141"), Unique:=False
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("l41:m42"), CopyToRange:=Range("z151"), Unique:=False
End With

Vielen Dank!
Gruß Holger

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Wiederholtes Datenfiltern vereinfachen

30.06.2010 10:27:25

Rudi

Hallo,
evtl. so:

Sub DBfiltern()
prcFilter Range("l4:m5"), Range("z1")
prcFilter Range("l6:m7"), Range("z11")
prcFilter Range("l9:m10"), Range("z21")
prcFilter Range("l11:m12"), Range("z31")
prcFilter Range("l14:m15"), Range("z41")
End Sub

Sub prcFilter(rngKriterium As Range, rngZiel As Range)
With ActiveSheet.Range("o1:w1000")
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rngKriterium, _
CopyToRange:=rngZiel, _
Unique:=False
End With
End Sub

Gruß
Rudi

AW: Wiederholtes Datenfiltern vereinfachen

30.06.2010 10:50:24

Das

Danke Rudi, das sieht sehr gut aus!
Noch eine grundsätzliche Frage: Kann man die Kriterien auch direkt im Code benennen? Man sieht im Filtercode ja nur ein "CriteriaRange".
Also wenn z.B. in l4:m5 und l6:m7 stehen würde
Tier | Farbe
Hase| braun
Tier | Farbe
Maus| grau
Gruß Holger

AW: Wiederholtes Datenfiltern vereinfachen

30.06.2010 11:11:26

Rudi

Hallo,
das geht nicht.
Man könnte aber die Kriterienbereiche in ein Array packen und dann mit einer Schleife arbeiten.

Sub DBfiltern()
Dim rngDB As Range, arrKriterium, iKriterium As Integer
arrKriterium = Array(Range("l4:m5"), Range("l6:m7"), Range("l9:m10"), _
Range("l11:m12"), Range("l14:m15"))
Set rngDB = ActiveSheet.Range("o1:w1000")
For iKriterium = 0 To UBound(arrKriterium)
With rngDB
.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=arrKriterium(iKriterium), _
CopyToRange:=Cells(iKriterium * 10 + 1, 26), _
Unique:=False
End With
Next iKriterium
End Sub

Gruß
Rudi

AW: Wiederholtes Datenfiltern vereinfachen

30.06.2010 11:21:37

Das

Hallo Rudi,
da ich sowieso mal mit Array arbeiten möchte, finde ich deine 2. Lösung besser.
Und ich habe etwas länger überlegen müssen, wie du die Zieladresse bestimmst, habe es jetzt aber kapiert. Auf so eine Idee würde ich erst gar nicht kommen ;-)
Vielen Dank!
Gruß Holger

Beliebteste Forumthreads (12 Monate)

Wiederholtes Datenfiltern vereinfachen

Forumthread: Wiederholtes Datenfiltern vereinfachen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread