Gruppe
Allgemein
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?
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