Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Aus einer Adressliste je 10 Adressen pro PLZ filtern

Gruppe

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