Herbers Excel-Forum - das Archiv

Hausnummern zuordnen

Bild

Betrifft: Hausnummern zuordnen
von: Frank B.

Geschrieben am: 18.02.2005 16:52:53
Hallo liebe Leute,
habe eine Riesen-Datei mit tausenden von Straßen und Nr. aufgelistet in sep. Zeilen (beispiel unten). Straßen und Nummern tauchen ungeordnet auf und müssen in nur ZWEI Zellen. Siehe Beispiel 2-te Datei.
Kann mir jemand helfen, mit Formel oder VBA
Danke, Frank B.
STRASSE NR.
Preußenstr. 2
Preußenstr. 4
Klinkeburg 1
Klinkeburg 1
Weg 4
Weg 6
Weg 8
Weg 10
Weg 3
Weg 5
Weg 7
Wilhelm-Krüger-Str. 1
Wilhelm-Krüger-Str. 2
Wilhelm-Krüger-Str. 3
Wilhelm-Krüger-Str. 4
Bremer Str. 2
Bremer Str. 4
Bremer Str. 6
Preußenstr. 6
Preußenstr. 8
Wilhelm-Krüger-Str. 5
Wilhelm-Krüger-Str. 6
Wilhelm-Krüger-Str. 7

So muss das Ergebnis aussehen:
STRASSE NUMMERN
Preußenstr. 2,4,6,8
Klinkeburg 1
Weg 3,4,5,6,7,8,10
Wilhelm-Krüger-Str. 1,2,3,4,5,6,7
Bremer Str. 2,4,6
Bild

Betrifft: AW: Hausnummern zuordnen
von: Kurt
Geschrieben am: 18.02.2005 17:30:51
Hei Frank,
bei VBA gut, solltest du das aber hinbekommen.

MfG Kurt
Bild

Betrifft: AW: Hausnummern zuordnen
von: Reinhold

Geschrieben am: 18.02.2005 17:31:23
Hallo Frank,
hab' dir ein kleine Macro geschrieben!
Die Hausnummern werden sortiert ausgegeben.
Ich hoffe es hilft dir weiter!
Sub sMain()
Dim r As Range
Dim coll As Collection
Dim arr() ' speichert die Hausnummern einer Strasse
Dim Strasse As String, HausNr As Long
Dim EingabeBereich As Range ' Zellen, die analisiert werden
Dim BeginnAusgabeZeile
Dim ExistsHNr As Boolean ' true, falls HausNr in dieser Strasse bereits vorhanden
Dim v As Variant, i As Long, j As Long, lng As Long
Set coll = New Collection
Set EingabeBereich = Range("A1").CurrentRegion
' Adressen in Collection speichern, damit doppelte Adressen erkannt werden können
' die Hausnummern je Adresse in array speichern
For Each r In EingabeBereich.Cells
Strasse = Left(r.Value, InStrRev(r.Value, " ") - 1)
HausNr = Mid(r.Value, InStrRev(r.Value, " ") + 1)
On Error Resume Next
arr = coll(Strasse)
If Err = 0 Then ' Strasse kommt bereits vor
On Error GoTo 0
' Überprüfen ob Hausnummer bereits vorkomme
ExistsHNr = False
For i = 1 To UBound(arr)
If arr(i) = HausNr Then
ExistsHNr = True
Exit For
End If
Next i
' Hausnummer hinzufügen, falls diese HausNr das erste mal vorkomme
If Not ExistsHNr Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = HausNr
coll.Remove Strasse
coll.Add key:=Strasse, Item:=arr
End If
Else ' Strasse kommt das erste mal vor
On Error GoTo 0
ReDim arr(1)
arr(0) = Strasse
arr(1) = HausNr
coll.Add key:=Strasse, Item:=arr
End If
Next r
' Ausgabe
BeginnAusgabeZeile = EingabeBereich.Cells(EingabeBereich.Cells.Count).Row + 2
For Each v In coll
' v sortieren
For i = 1 To UBound(v)
For j = i To UBound(v)
If v(i) > v(j) Then
lng = v(i)
v(i) = v(j)
v(j) = lng
End If
Next j
Next i
Cells(BeginnAusgabeZeile, EingabeBereich.Column).Value = Join(v, ", ")
BeginnAusgabeZeile = BeginnAusgabeZeile + 1
Next v
End Sub

grüße Reinhold
Bild

Betrifft: AW: Hausnummern zuordnen
von: Reinhold

Geschrieben am: 18.02.2005 17:31:28
Hallo Frank,
hab' dir ein kleine Macro geschrieben!
Die Hausnummern werden sortiert ausgegeben.
Ich hoffe es hilft dir weiter!
Sub sMain()
Dim r As Range
Dim coll As Collection
Dim arr() ' speichert die Hausnummern einer Strasse
Dim Strasse As String, HausNr As Long
Dim EingabeBereich As Range ' Zellen, die analisiert werden
Dim BeginnAusgabeZeile
Dim ExistsHNr As Boolean ' true, falls HausNr in dieser Strasse bereits vorhanden
Dim v As Variant, i As Long, j As Long, lng As Long
Set coll = New Collection
Set EingabeBereich = Range("A1").CurrentRegion
' Adressen in Collection speichern, damit doppelte Adressen erkannt werden können
' die Hausnummern je Adresse in array speichern
For Each r In EingabeBereich.Cells
Strasse = Left(r.Value, InStrRev(r.Value, " ") - 1)
HausNr = Mid(r.Value, InStrRev(r.Value, " ") + 1)
On Error Resume Next
arr = coll(Strasse)
If Err = 0 Then ' Strasse kommt bereits vor
On Error GoTo 0
' Überprüfen ob Hausnummer bereits vorkomme
ExistsHNr = False
For i = 1 To UBound(arr)
If arr(i) = HausNr Then
ExistsHNr = True
Exit For
End If
Next i
' Hausnummer hinzufügen, falls diese HausNr das erste mal vorkomme
If Not ExistsHNr Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = HausNr
coll.Remove Strasse
coll.Add key:=Strasse, Item:=arr
End If
Else ' Strasse kommt das erste mal vor
On Error GoTo 0
ReDim arr(1)
arr(0) = Strasse
arr(1) = HausNr
coll.Add key:=Strasse, Item:=arr
End If
Next r
' Ausgabe
BeginnAusgabeZeile = EingabeBereich.Cells(EingabeBereich.Cells.Count).Row + 2
For Each v In coll
' v sortieren
For i = 1 To UBound(v)
For j = i To UBound(v)
If v(i) > v(j) Then
lng = v(i)
v(i) = v(j)
v(j) = lng
End If
Next j
Next i
Cells(BeginnAusgabeZeile, EingabeBereich.Column).Value = Join(v, ", ")
BeginnAusgabeZeile = BeginnAusgabeZeile + 1
Next v
End Sub

grüße Reinhold
Bild

Betrifft: AW: Hausnummern zuordnen
von: Frank B.
Geschrieben am: 21.02.2005 12:06:13
Danke für die Hilfe,
muss noch ein wenig basteln, da Straße und Haus Nr. in zwei sep. Zellen stehen und in eine zusammengefügt werden müssen...
 Bild
Excel-Beispiele zum Thema "Hausnummern zuordnen"
Einen Wert in einem zweiten Blatt einer Kalenderwoche zuordnen Adresse bei mehrfach vorkommenden Namen zuordnen
Telefonnummern den Telefonierern zuordnen