PDA

Vollständige Version anzeigen : Nachträgliches Trennen von Straße und Hausnummer


TommyK
01.11.2004, 16:52
Hallo,

bezugnehmend auf diesen Thread:
Hausnummer aus Strassenangabe filtern (http://www.ms-office-forum.net/forum/showthread.php?t=137888&highlight=Trenn%2A+Stra%DFe%2A)
Hab ich aus der Lösung von Sascha eine Bsp DB erstellt.
Weitere Erklärungen kann man sich sparen, da das Bsp eigentlich selbst erklärend ist.
Da A97 die Funktion "InStrRev" nicht kennt, kamen die erforderlichen Funktionen von R. Kraasch zum Einsatz.

Red2410x
23.01.2012, 08:49
Ersteinmal vielen Dank. Leider funktioniert das Modul nicht durchgehend. Meine Kenntnisse Richtung VBA sind 0. Somit kann ich eine korrektur nicht eigenständig vornehmen.

Als Beispiel:
Strasse Str HNr
PetkusserStr.44a PetkusserStr. 44a
Grubenweg12 Grubenweg 12
Ulnerstr.2 Ulnerstr.2
Tulpenweg7 Tulpenweg7

Werden die letzten 2 nicht getrennt. Warum?

TommyK
23.01.2012, 09:31
Hallo,

ändere in beiden Funktionen diesen Ausschnitt:

If i < L Then
arrStreet(0) = Trim(Left(AStreet, i - 1))
arrStreet(1) = (Mid(AStreet, i))
Else
arrStreet(0) = AStreet
End If

in

If i <= L Then
arrStreet(0) = Trim(Left(AStreet, i - 1))
arrStreet(1) = (Mid(AStreet, i))
Else
arrStreet(0) = AStreet
End If


Dann sollte es klappen.

Red2410x
23.01.2012, 11:33
Vielen, vielen Dank es klappt. Eine fast universelle Lösung. Eine Frage habe ich noch. Gibt es noch eine Möglichkeit, damit folgende Problemstellung aufzufangen:

Beispiele:
SildemowerWeg
PetkusserStr.
AmRökerberg
AmHirschwechsel
MuenchnerStr.

M.a.W. beginnt innerhalb eines Straßenamens, etwas mit großem Buchstaben, dann füge eine Leerstelle davor. Danke vorab

Red2410x
23.01.2012, 12:46
Auf diesem Weg hatte Du schnell geantwortet. Dahingehend Vielen, vielen Dank es klappt. Eine fast universelle Lösung. Eine Frage habe ich noch. Gibt es noch eine Möglichkeit, damit folgende Problemstellung aufzufangen:

Beispiele:
SildemowerWeg
PetkusserStr.
AmRökerberg
AmHirschwechsel
MuenchnerStr.

M.a.W. beginnt innerhalb eines Straßenamens, etwas mit großem Buchstaben, dann füge eine Leerstelle davor. Danke vorab

Red2410x
23.01.2012, 13:02
Mit Excel habe ich eine Lösung:

Suchen nach
[ABCDEFGHIJKLMOPQRSTUVWXYZÄÖÜ]{1}

Ersetze
^&

Aktivieren:Platzhalterzeichen verwenden

Ich würde dies aber gerne direkt in Access 2003 bei einer Abfrage umsetzen.

Danke vorab

TommyK
24.01.2012, 08:31
Hallo,

Lösung könnte so aussehen:
Diese Funktion in das Modul kopieren

Private Function Split_Letter(sStreet As String) As String
Dim i As Long, l As Long, k As Long
Dim sTemp As String, sLetter As String, sResult As String, sLetterRev As String

l = Len(sStreet)
For i = l To 1 Step -1
sLetter = Mid(sStreet, i, 1)
Select Case Asc(sLetter)
Case 65 To 90, 196, 214, 220
sTemp = sTemp & sLetter & " "
Case Else
sTemp = sTemp & sLetter
End Select
Next i
k = Len(sTemp)
For i = k To 1 Step -1
sLetterRev = Mid(sTemp, i, 1)
sResult = sResult & sLetterRev
Next i
Split_Letter = sResult
End Function

Und dann diese Funktion ersetzen:

Function SplitStreet_1(AStreet As String, Optional fModus As Boolean = True) As String
Dim arrStreet(1) As String
Dim n As Long, n1 As Long, n2 As Long, m As Long
Dim i As Long
Dim l As Long

On Error Resume Next

l = Len(AStreet)
n = InStrRev(AStreet, " ", , vbTextCompare)
If n = 0 Then
For i = 1 To l
If IsNumeric(Mid(AStreet, i, 1)) Then Exit For
Next i
If i <= l Then
arrStreet(0) = Split_Letter(Trim(Left(AStreet, i - 1)))
arrStreet(1) = (Mid(AStreet, i))
Else
arrStreet(0) = Split_Letter(AStreet)
End If
Else
Do
m = n
n1 = InStrRev(AStreet, " ", n - 1, vbTextCompare)
n2 = InStrRev(AStreet, ".", n - 1, vbTextCompare)
If (n1 = 0 And n2 = 0) Then
Exit Do
Else
If n2 = 0 Then n = n1 Else n = n2
End If
If Not IsNumeric(Mid(AStreet, n + 1, 1)) Then Exit Do
Loop
arrStreet(0) = Split_Letter(Trim(Left(AStreet, m)))
arrStreet(1) = Mid(AStreet, m + 1)
End If
If fModus = True Then
SplitStreet_1 = arrStreet(0)
Else
SplitStreet_1 = arrStreet(1)
End If
End Function

Red2410x
24.01.2012, 08:52
Hallo ThommyK,

danke es funktioniert. Ich möchte nicht zu viel fordern, aber vielleicht ist es auch in Deinem Interesse:

Es tauchen jetzt natürlich auch folgende Ergebnisse auf.
Johann-Sebastian-Bach-Str.6
Johann- Sebastian- Bach- Str. 6

D.h. nach Bindestrich und vor Großbuchstaben wird auch ein Leerzeichen eingefügt. Ebenfalls wird am Anfang eines Straßenname auch ein Buchstabe eingefügt. Hier kann ich aber mit der Funktion Teil arbeiten.

Ich hätte die Spezifikation besser formulieren sollen, aber meine Erwartungen wurden übertroffen. :mrcool:

Ansonsten ist mir nichts mehr aufgefallen. Und noch einmals vielen Dank für Deine Bemühungen und Unterstützung.

TommyK
24.01.2012, 14:25
Hallo,

dann so:

Function SplitStreet_1(AStreet As String, Optional fModus As Boolean = True) As String
Dim arrStreet(1) As String
Dim n As Long, n1 As Long, n2 As Long, m As Long
Dim i As Long
Dim l As Long

On Error Resume Next

l = Len(AStreet)
n = InStrRev(AStreet, " ", , vbTextCompare)
If n = 0 Then
For i = 1 To l
If IsNumeric(Mid(AStreet, i, 1)) Then Exit For
Next i
If i <= l Then
arrStreet(0) = Replace(Split_Letter(Trim(Left(AStreet, i - 1))), "- ", "-")
arrStreet(1) = (Mid(AStreet, i))
Else
arrStreet(0) = Replace(Split_Letter(AStreet), "- ", "-")
End If
Else
Do
m = n
n1 = InStrRev(AStreet, " ", n - 1, vbTextCompare)
n2 = InStrRev(AStreet, ".", n - 1, vbTextCompare)
If (n1 = 0 And n2 = 0) Then
Exit Do
Else
If n2 = 0 Then n = n1 Else n = n2
End If
If Not IsNumeric(Mid(AStreet, n + 1, 1)) Then Exit Do
Loop
arrStreet(0) = Replace(Split_Letter(Trim(Left(AStreet, m))), "- ", "-")
arrStreet(1) = Mid(AStreet, m + 1)
End If
If fModus = True Then
SplitStreet_1 = arrStreet(0)
Else
SplitStreet_1 = arrStreet(1)
End If
End Function

Dann werden die Leerzeichen nach den Trennsrichen entfernt

Red2410x
24.01.2012, 15:57
es funktioniert alles. Noch einmal ein Danke und viele Grüße :sun:

mbanf
16.11.2015, 17:45
Hallo
Bei mir kommt immer die fehlermeldung " Projekt oder Bibilothek nicht gefunden "
was kann ich tun

gruss Micha

TommyK
17.11.2015, 08:49
@Micha
Bei mir kommt immer die fehlermeldung " Projekt oder Bibilothek nicht gefunden "
Prüfe mal im VBA Editor im Menü -> Extras -> Verweise ob ein Verweis fehlt.