Aus einer Adressliste je 10 Adressen pro PLZ filtern

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

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