Rusty hat eine Liste mit Postleitzahlen in einer Spalte eines Arbeitsblatts. Er möchte eine Möglichkeit, die Codes so zu „komprimieren“, dass sich aufeinanderfolgende Wertebereiche in einer einzelnen Zeile befinden. Anstatt beispielsweise 35013, 35014 und 35015 drei Zeilen einzunehmen, werden sie in einer einzelnen Zeile als 35013-35015 angezeigt.

Es gibt verschiedene Möglichkeiten, dies zu tun – mit oder ohne Makros. Auf der Seite „ohne Makros“ des Zauns gibt es verschiedene Ansätze, und alle beinhalten die Verwendung zusätzlicher Spalten, um Zwischenergebnisse zu speichern.

Angenommen, Sie haben Ihre Daten in Spalte A, beginnend in Zelle A2, und die Zelle A1 ist leer (sie enthält nicht einmal Kopfzeilentext). In diesem Fall können Sie die folgende Formel in Zelle B2 eingeben:

=IF(NOT(A2-A1=1),A2,IF(A3-A2=1,B1,A2))

Geben Sie dann in Zelle C2 die folgende lange Formel ein:

=IF(NOT(A3-A2=1),IF(A2-A1=1,TEXT(B1,"00000")

&" - "&TEXT(B2,"00000"),TEXT(A2,"00000")),"")

Jetzt können Sie die Formeln in den Zellen B2: C2 in die entsprechenden Spalten kopieren. Was Sie in Spalte C finden, ist die komprimierte Reihe von Postleitzahlen. Sie können diese Werte mit Paste Special kopieren, um leere Zellen zu ignorieren, an einen beliebigen anderen Ort.

Wenn Sie einen Makroansatz verwenden möchten, sind keine Zwischenspalten erforderlich. Es kann ein Makro geschrieben werden, das die Liste der vorhandenen Postleitzahlen im Wesentlichen reduziert. Das folgende Makro durchläuft den von Ihnen ausgewählten Zellenbereich und erstellt die komprimierte Liste:

Sub CombineValues()

Dim rng As Range     Dim rCell As Range     Dim sNewArray() As String     Dim x As Long     Dim y As Long     Dim sStart As String     Dim sEnd As String

Set rng = Selection     sStart = rng.Cells(1)

sEnd = sStart     y = 1     For x = 1 To rng.Count - 1         If rng.Cells(x + 1) - _           rng.Cells(x) > 1 Then  'End             ReDim Preserve sNewArray(1 To y)

If sStart = sEnd Then                 sNewArray(y) = sStart             Else                 sNewArray(y) = sStart & "-" & sEnd             End If             sStart = rng.Cells(x + 1)

y = y + 1         End If         sEnd = rng.Cells(x + 1)

ReDim Preserve sNewArray(1 To y)

If sStart = sEnd Then             sNewArray(y) = sStart         Else             sNewArray(y) = sStart & "-" & sEnd          End If     Next     rng.ClearContents     For x = 1 To y         rng.Cells(x) = "'" & sNewArray(x)

Next     Set rng = Nothing     Set rCell = Nothing End Sub

_Hinweis: _

Wenn Sie wissen möchten, wie die auf dieser Seite (oder auf einer anderen Seite der ExcelTips-Websites) beschriebenen Makros verwendet werden, habe ich eine spezielle Seite vorbereitet, die hilfreiche Informationen enthält.

Klicken Sie hier, um diese spezielle Seite in einem neuen Browser-Tab zu öffnen.

ExcelTips ist Ihre Quelle für kostengünstige Microsoft Excel-Schulungen.

Dieser Tipp (11977) gilt für Microsoft Excel 2007, 2010, 2013 und 2016.

Eine Version dieses Tipps für die ältere Menüoberfläche von Excel finden Sie hier:

Sequenzielle Werte zu einer einzelnen Zeile verdichten.