daten in Spalte in Zeile ausgeben

Question

Hallo,
ich habe folgendes Problem: In Spalte A stehen Straßennamen, die nach Alphabet sortiert sind. Diese Straßennamen treten oftmals mehrfach auf und in Spalte B stehen die Hausnummern zu den Straßennamen. Ich möchte, das in Spalte A die mehrfach auftretenden gleichen Straßennamen nur einmal erscheinen und die zu den Namen gehörenden Hausnummern in der selben Zeile nebeneinander stehen. Beispiel: aus Antonstr. 2
Antonstr. 4
Bertastr. 3
Bertastr. 5
soll Antonstr. 2, 4
Bertastr. 3, 5 werden. Lässt sich das mit einem Makro oder mit einer Formel lösen ? Danke für Eure Hilfe.
tomax151

Answer 1

Hallo Tomax,

probiers mal mit diesem Makro:

Sub Zusammenfügen()

Application.ScreenUpdating = False
Do
z = z + 1
If Cells(z + 1, 1) = Cells(z, 1) Then
Cells(z, 2) = Cells(z, 2) & ", " & Cells(z + 1, 2)
Rows(z + 1).Delete
z = z - 1
End If
Loop Until Cells(z + 1, 1) = ""
Application.ScreenUpdating = True

End Sub

Gruß Mr. K.

Answer 2

hi excelk ^^

wenn du z.b. nach der übernahme der nummer die zelle auf true setzt
kannst du nun in einem rutsch die nicht mehr benötigten zeilen löschen

gruss nighty

Range("B:B").AutoFilter Field:=1, Criteria1:=True
Rows("2:" & Cells(Rows.Count, 2).End(xlUp).Row).Delete Shift:=xlUp
Cells(1, 2).AutoFilter

Answer 3

Hi nighty,

gute Idee. Das dürfte den Durchlauf noch etwas beschleunigen.

Mr. K.

Answer 4

Hallo ExcelKing und nighty,
erstmal vielen Dank für eure Mühe. Das Makro von Excelking ist genau das, was ich gesucht habe. Aufgabe gelöst !! Da ich kein Experte bin, kann ich mit den Zeilen von nighty leider nicht viel anfangen. Ist das ein verbessertes Makro, oder muß ich das irgendwo einfügen ?
Freundliche Grüße
tomax151

Answer 5

Hallo Tomax,

Es gibt Code der einfach, übersichtlich und schnell geschrieben ist und genau das macht, was er soll (siehe Antwort 1), und dann gibt es Code der wesentlich zeitaufwendiger zu erstellen ist, jedoch dafür schneller durchläuft oder sich einfacher an neue Gegebenheiten (z.B. ein anderer Bezug) anpassen lässt.

Was Nighty meint, ist, dass das Löschen von mehreren Zeilen auf einen Schlag schneller vonstatten geht, als jede Zeile einzeln zu löschen. Leider lässt sich das in meinen Code oben nicht integrieren, da die jeweils folgende Zeile auf Gleichheit überprüft wird.

Ob jedoch der Autofilter der richtige Weg ist, wag ich mittlerweile zu bezweifeln. Zumindest bei mir dauert das Löschen von Zeilen einer Mehrfachmarkierung im Autofilter erheblich länger als ohne Filter.

Im folgenden Code gehe ich daher einen anderen Weg und lege die Zeilen gleich als Multibereich fest. Die Laufzeitverkürzung wird jedoch durch ein zusätzliches Feature etwas relativiert. Ich habe hier noch eingebaut, dass die Hausnummern 1, 2, 3, 4, 5 zu [1-5] werden.

Sub Zusammenfügen()

Dim del As Range

Set Bereich = Columns("A:B") 'Geben Sie den DatenBereich an

With Bereich
Application.ScreenUpdating = False

.Sort Key1:=Bereich.Cells(1), Order1:=xlAscending, Key2:=Bereich.Cells(2) _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom 'Sortiert den Bereich, falls nich schon sortiert

.WrapText = True 'setzt einen automatischen Zeilenumbruch, damit alle Daten sichtbar werden.

z = Bereich.Row
d = Bereich.Row + 1
Do
von = .Cells(z, 2): bis = von
.Cells(z, 2) = ""

While .Cells(d, 1) = .Cells(z, 1)

'prüft ob aufeinanderfolgende Hausnummern vorliegen.
If .Cells(d, 2) = bis + 1 Then
bis = bis + 1
ElseIf bis <> von Then
.Cells(z, 2) = .Cells(z, 2) & "[" & von & "-" & bis & "]" & ", "
von = .Cells(d, 2): bis = von
Else
.Cells(z, 2) = .Cells(z, 2) & von & ", "
von = .Cells(d, 2): bis = von
End If

'Bestimmt den zu löschenden Bereich
If del Is Nothing Then
Set del = Rows(d)
Else
Set del = Union(del, Rows(d))
End If

d = d + 1
Wend

'fügt die letzte/n Hausnummer/n einer Straße hinzu
If bis <> von Then
.Cells(z, 2) = .Cells(z, 2) & "[" & von & "-" & bis & "]"
Else
.Cells(z, 2) = .Cells(z, 2) & von
End If

z = d
d = d + 1
Loop Until .Cells(d, 1) = ""
del.Delete 'Löscht die unnötigen Zeilen.

Application.ScreenUpdating = True
End With

End Sub

Damit sich die unterschiedliche Durchlaufzeit aber überhaupt auswirkt, musst du schon sehr viele Daten haben. Bei 60.000 Zeilen merke ich durchaus eine Verbesserung zu Antwort 1.

Gruß Mr. K.

Answer 6

hi all ^^

im allgemeinen

eine beschränkung der Syntax gibt es nicht
die phantasie ist es die die Syntax beschränkt

gruss nighty