Straßenname Hausnummer trennen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Straßenname Hausnummer trennen

06.02.2004 12:12:02

th.heinrich

AW: Straßenname Hausnummer trennen

06.02.2004 14:37:29

Peter Feustel

noch was ausgegraben

06.02.2004 16:24:46

th.heinrich

AW: noch was ausgegraben

06.02.2004 21:26:09

Peter Feustel

loesung

07.02.2004 00:21:18

th.heinrich

AW: loesung

07.02.2004 16:40:04

Peter Feustel

danke fuer die rueckmeldung mt.

07.02.2004 20:17:08

th.heinrich

Hallo Thomas,
hier das Makro:

'
'----------------------------------------------------------------------------'
'            Sub Strasse_Hausnr trennt Straßenname und Hausnummer.           '
'                                                                            '
'            Die Straßennamen, insbesondere jedoch die Hausnummern           '
'               in eine aufsteigend sortierfähige Form bringen.              '
'                                                                            '
'         Dabei wird die Hausnummer in zwei Bereiche übertragen,  die        '
'         jeder 5 Stellen lang  sind.  Teil 1 enthält alles,  was vor        '
'         dem Trennzeichen einer Hausnummer VON - BIS  steht,  Teil 2        '
'         das, was hinter dem Trennzeichen  kommt.  Als  Trennzeichen        '
'         wird zur Zeit '-', '+', '/' akzeptiert.                            '
'         Es können maximal 4-stellige Nummern + ein Buchstabe verar-        '
'         beitet werden.                                                     '
'         Nach  der Bearbeitung steht eine Hausnummer im 10-stelligen        '
'         Bereich folgendermaßen zur Sortierung zur Verfügung:               '
'                                                                            '
'         7              als    . . . .7. | . . . . .                        '
'         13a            als    . . .1.3.a| . . . . .                        '
'         127-129f       als    . .1.2.7. | .1.2.9.f.                        '
'         12 + 37        als    . . .1.2. | . .3.7. .                        '
'         37 d           als    . . .3.7.d| . . . . .                        '
'         12 - 15 e      als    . . .1.2. | . .1.5.e.                        '
'         12/II          als    . . .1.2. | . . .I.I.                        '
'                                                                            '
'         Die  Stellen 5 und 10 sind immer für einen evtl. Buchstaben        '
'         reserviert.                                                        '
'         Die Hausnummern 1c, 4b, 10, 101 in der gleichen Straße wer-        '
'         den  so  nicht als 10, 101, 1c, 4b sortiert, sondern in der        '
'         richtigen aufsteigenden Sortierfolge, 1c, 4b, 10, 101.             '
'----------------------------------------------------------------------------'
'
Sub Strasse_Hausnr()
Dim iZeile      As Integer                                    ' Zeilen-Index
Dim iLaenge     As Integer                                    ' For/Next Index Laenge
Dim sStrHNr     As String                                     ' Eingabewerte
Dim sStrName    As String                                     ' Straßenname separiert
Dim sHausNr     As String                                     ' Hausnummer  separiert
Dim sZeichen    As String * 1                                 ' jeweils ein Zeichen
Dim iHNrPos     As Integer                                    ' Position im Hausnr-Bereich 1-5/6-10
Dim sHNrLg4     As String * 4                                 ' 4-stelliges Hilfsfeld
Dim sSortNr     As String * 10                                ' Hausnummer(n) zum Sortieren
On Error GoTo Fehler
iZeile = 2                                                    ' ab Zeile 2
Do Until IsEmpty(Cells(iZeile, 1))
   sStrHNr = Range("A" & iZeile)                              ' Anschrift holen
   sStrHNr = Replace(sStrHNr, "" & Chr$(10) & "", " ", 1)     ' Zeilenumbruch entfernen
   sStrHNr = Replace(sStrHNr, ",", "", 1)                     ' Kommata entfernen
   sStrHNr = Trim(sStrHNr)                                    ' führende/nachfolgende Space entfernen

   sStrName = sStrHNr                                         ' falls Name ohne Hausnummer
   sHausNr = ""                                               ' Hausnummer löschen
'
'  aufsplitten des Straßennamens incl. Hausnummer von links ausgehend in Namen und Hausnummer.
'  Wird eine Leerstelle gefunden wird geprüft, ob die Stelle danach ein Buchstabe war bzw.
'  keine Zahl gewesen ist. Ist das der Fall, wird weitergesucht - Hausnummern 3 a, 55 c -
'  wenn nicht wird geprüft, ob die Stelle vor dem Leerzeichen ein Trennzeichen (-, +, /) ist.
'  Ist das der Fall, wird weitergesucht - Hausnummern 3 a - 3 c, 55 + 59, 12 / II -
'
'  Es wird sicherlich noch andere exotische Schreibweisen geben, die hier nicht erkannt werden!
'
   For iLaenge = Len(Trim(sStrHNr)) To 1 Step -1              ' Hausnummer/Straße separieren
      If Mid(sStrHNr, iLaenge, 1) = " " Then
         If Not IsNumeric(Mid(sStrHNr, iLaenge + 1, 1)) Then  ' war das ggf. ein Buchstabenanhängsel ?
          ElseIf Mid(sStrHNr, iLaenge - 1, 1) = "-" Or _
                 Mid(sStrHNr, iLaenge - 1, 1) = "+" Or _
                 Mid(sStrHNr, iLaenge - 1, 1) = "/" Then      ' Trennzeichen (-, +, /) ?
          Else
            sHausNr = Right(sStrHNr, Len(sStrHNr) - iLaenge)  ' Hausnummern  separieren
            sStrName = Left(sStrHNr, iLaenge)                 ' Straßennamen separieren
            Exit For                                          ' For/Next verlassen
         End If
      End If
   Next iLaenge                                               ' nächstes Zeichen
   Range("B" & iZeile).Value = sStrName                       ' Straßennamen anzeigen
   Range("C" & iZeile).Value = sHausNr                        ' Hausnummer anzeigen
'
'  aufteilen der Hausnummer in die oben beschriebene 10-stellige Schreibweise
'
   iHNrPos = 1                                                ' Position Teil 1 = ab 1 - 5
   sSortNr = ""                                               ' Sort-Hausnummer löschen

   For iLaenge = 1 To Len(Trim(sHausNr))                      ' Hausnummer/Straße separieren
      sZeichen = Mid(sHausNr, iLaenge, 1)                     ' Eingaben zeichenweise abarbeiten
      If sZeichen = " " Then                                  ' Leerstelle ?
      '   GoTo naechstes_Zeichen                              ' dann weitersuchen
      ElseIf sZeichen = "-" Or _
             sZeichen = "+" Or _
             sZeichen = "/" Then                              ' Trennzeichen (-, +, /) ?
             iHNrPos = 6                                      ' Position Teil 2 = ab 6
      Else
         Mid(sSortNr, iHNrPos, 1) = sZeichen                  ' Zeichen übernehmen
         iHNrPos = iHNrPos + 1                                ' Position weiterrechnen
      End If
   Next iLaenge                                               ' nächstes Zeichen

   If Left(sSortNr, 5) <> " " Then                            ' Hausnummer gefunden ?
      Do While Mid(sSortNr, 5, 1) = " "                       ' Hausnummer Stelle 5 leer ?
         sHNrLg4 = Left(sSortNr, 4)                           ' Hausnummer 1-4 in Zwischenfeld
         Mid(sSortNr, 2, 4) = sHNrLg4                         ' Hausnummer shiften
         Mid(sSortNr, 1, 1) = "."                             ' Hausnummer mit Punkt auffüllen
      Loop
   End If
                                                              ' Stelle 5 für Buchstaben reserviert
   If IsNumeric(Mid(sSortNr, 5, 1)) Then                      ' Hausnummer Stelle 5 numerisch ?
      Mid(sSortNr, 1, 4) = Mid(sSortNr, 2, 4)                 ' Stelle 2-4 nach Stelle 1-4
      Mid(sSortNr, 5, 1) = " "                                ' Stelle 5 löschen
   End If

'                                                             ' Hausnr_Teil_2: Stellen 6 - 10
   If Right(sSortNr, 5) = " " Then                            ' rechte 5 Stellen leer ?
   '  GoTo Ausgabe sSortNr                                    ' dann ist die Verarbeitung fertig
    Else
      Do While Mid(sSortNr, 10, 1) = " "                      ' Hausnummer Stelle 10 leer ?
         sHNrLg4 = Mid(sSortNr, 6, 4)                         ' Hausnummer 6-9 in Zwischenfeld
         Mid(sSortNr, 7, 4) = sHNrLg4                         ' Hausnummer shiften
         Mid(sSortNr, 6, 1) = "."                             ' Hausnummer mit Punkt auffüllen
      Loop
   End If
                                                              ' Stelle 10 für Buchstaben reserviert
   If IsNumeric(Right(sSortNr, 1)) Then                       ' Hausnummer Stelle 10 numerisch ?
      Mid(sSortNr, 6, 4) = Mid(sSortNr, 7, 4)                 ' Stelle 7-10 nach Stelle 6-9
      Mid(sSortNr, 10, 1) = " "                               ' Stelle 10 löschen
   End If

   Range("D" & iZeile).Value = sSortNr                        ' Sort-Hausnnummer anzeigen

   iZeile = iZeile + 1                                        ' nächste Eingabe
Loop
Exit Sub
Fehler:
MsgBox "der Fehler ist in Zeile " & iZeile & " aufgetreten" & vbCrLf & vbCrLf _
     & "Straßenname ist " & sStrName & vbCrLf _
     & "Hausnummer ist " & sHausNr & vbCrLf _
     & "Sortier-Nummer ist " & sSortNr _
     , 64, "ein Fehler ist aufgetreten"
Resume Next
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß, Peter

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread