Gruppe
Allgemein
Bereich
Filtern
Thema
Aus einer Adressliste je 10 Adressen pro PLZ filtern
Problem
Wie kann ich aus einer Adressliste die Adressen einer Liste vorgegebener PLZ filtern und vom Ergebnis maximal 10 Stück pro PLZ auflisten lassen?
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub FilternPLZ()
Dim iRow As Integer, iCounter As Integer, iRowT As Integer
Application.ScreenUpdating = False
Columns("A:C").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("E1").CurrentRegion, _
CopyToRange:=Range("I1"), _
Unique:=False
Columns("I:K").Sort _
Key1:=Range("K2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iRow = Cells(Rows.Count, 11).End(xlUp).Row
Columns("A:H").Delete
Range("A:C").Copy Range("D:F")
iRow = 2
iRowT = 1
Do Until IsEmpty(Cells(iRow, 3))
Do Until Cells(iRow, 3).Value <> Cells(iRow + 1, 3).Value
iCounter = iCounter + 1
If iCounter <= 10 Then
iRowT = iRowT + 1
Range(Cells(iRowT, 4), Cells(iRowT, 6)).Value = _
Range(Cells(iRow, 1), Cells(iRow, 3)).Value
End If
iRow = iRow + 1
Loop
iCounter = 0
iRow = iRow + 1
Loop
Columns("A:C").Delete
End Sub