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

Beiträge aus den Excel-Beispielen zum Thema "Hausnummern zuordnen"