VBA Tipp: Straße und Hausnummer extrahieren

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung:

Ich will ein Feld, das den Straßennamen mit Hausnummer enthält, in einzelne Felder "Straßenname" und "Hausnummer" zerlegen.

Lösung:

Eine 100%ige Lösung dieses Problems gibt es nicht, aber die folgenden Funktionen, die in einem globalen Modul hinterlegt werden, dürften in den allermeisten Fällen ein richtiges Resultat liefern.

Public Function SplitStrasseHausNr(ByVal StrasseHausNr As Variant, _
                                   ByRef Strasse As String, _
                                   ByRef HausNr As String) As Boolean
 
 'StrasseHausNr wird in Strasse und HausNr zerlegt.
 'Quelle: http://www.dbwiki.net/
 
 'Heuristik:
 '- Hausnummer: Die durch Leerzeichen getrennten Teilzeichenketten werden von hinten zusammengefasst
 '  bis zur ersten Teilzeichenkette, die überwiegend Zeichen des Alphabets enthält
 '- Strasse: Die verbleibenden Teilzeichenketten.
 
 Dim i As Long
 Dim j As Long
 Dim k As Long
 Dim z As Long
 Dim Zeichen As String
 Dim StrGefunden As Boolean
 Dim Teile() As String
 Dim Teil As String
 
 If IsNull(StrasseHausNr) Then
   Exit Function
 End If
 
 Teile = Split(StrasseHausNr, " ")
 Strasse = ""
 HausNr = ""
 
 For i = UBound(Teile) To LBound(Teile) Step -1
 
   Teil = Teile(i)
 
   If Len(Teil) > 0 Then
     z = 0
 
     'Buchstaben im Teilstring zählen
     For k = 1 To Len(Teil)
       Zeichen = Mid(Teil, k, 1)
       If Zeichen >= "A" And Zeichen <= "Z" Then
         z = z + 1
       End If
     Next k
 
     'wenn mehr als 50% Buchstaben im Wort, ist es eine Strasse
     If z / Len(Teil) > 0.5 Then
       StrGefunden = True
       Exit For
     End If
 
   End If
 
   'HausNr-Teile zusammensetzen
   HausNr = Teil & " " & HausNr
 Next i
 
 'wenn keine HausNr gefunden wird, Spezialsuche nach HausNr
 If HausNr = "" Then
 
   'Bei der ersten Ziffer Schleife verlassen
   For k = 1 To Len(StrasseHausNr)
       If IsNumeric(Mid(StrasseHausNr, k, 1)) Then
         Exit For
       End If
   Next k
 
   'wenn eine Zahl existiert, Strasse und HsNr trennen
   If k <= Len(StrasseHausNr) Then
     Strasse = Trim(Left(StrasseHausNr, k - 1))
     HausNr = (Mid(StrasseHausNr, k))
 
   'ansonsten ganzen String als Strasse zurückgeben
   Else
     Strasse = StrasseHausNr
   End If
 
 Else
 
   'wenn keine Strasse gefunden wird
   If Not StrGefunden Then
     Strasse = StrasseHausNr
     HausNr = ""
   'ansonsten Strassenteile zusammensetzen
   Else
     For j = LBound(Teile) To i
       Strasse = Strasse & " " & Teile(j)
     Next j
     HausNr = Trim(HausNr)
     Strasse = Trim(Strasse)
   End If
 
 End If
 
 SplitStrasseHausNr = True
 
End Function
 
 
Public Function SplitStrasse(S)
 
 Dim St As String
 Dim Hn As String
 
 SplitStrasse = Null
 
 If Not IsNull(S) Then
   If SplitStrasseHausNr(S, St, Hn) Then
     If St <> "" Then SplitStrasse = St
   End If
 End If
 
End Function
 
Public Function SplitHausNr(S)
 
 Dim St As String
 Dim Hn As String
 
 SplitHausNr = Null
 
 If Not IsNull(S) Then
   If SplitStrasseHausNr(S, St, Hn) Then
     If Hn <> "" Then SplitHausNr = Hn
   End If
 End If
 
End Function

Aufruf im Direktfenster

Möglichkeit 1:

 Debug.Print SplitStrasse("Obere Str.57B /IV re")
 Debug.Print SplitHausNr("Obere Str.57B /IV re")

Möglichkeit 2:

 Dim strStraße As String
 Dim strHausnummer As String
 
 Call SplitStrasseHausNr("Obere Str.57B /IV re", strStraße, strHausnummer)
 
 Debug.Print strStraße
 Debug.Print strHausnummer

Verwendung in einer Abfrage

Mit folgender SQL erhält man Straße und Hausnummer:

SELECT SplitStrasse(StrasseMitHausnummer) AS Strasse,
       SplitHausNr(StrasseMitHausnummer) AS Hausnummer
FROM MeineTabelle

Web-Links