Strassennamen standardisieren mit Makro

Computer: Software & Programmierung Visual Basic
#1

Hallo liebe wer-weiss-wasler!

Meine Frage an euch richtet sich auf eine automatisierte Vereinheitlichung von Straßennamen mit zugehörigen Hausnummern und Hausnummernzusätzen.
Da es sich dabei um Datensätze ganzer Städte handelt (>10.000 Datensätze), soll das ganze mit Hilfe eines Makros in Excel (oder auch Access) gemacht werden.
Die Daten liegen in der Form vor, dass in einem Feld sowohl Straßenname als auch Hausnummer mit Zusatz notiert sind.

Bsp.: Maierdorfstr. 16 B

Das Makro soll nun zum einen den Hausnummernzusatz und die Hausnummer in ein neu angelegtes Feld kopieren.

Das klappt für die Hausnummer beim genannten Fall ganz gut mit der Funktion

„Extrahieren der HausNummern“

Function numbersOnly(strInput As String) As String
Dim x As Integer
Dim strNumber As String
For x = 1 To Len(strInput)
If (Asc(Mid(strInput, x, 1)) > 47 And Asc(Mid(strInput, x, 1)) ergibt Hausnummer 2325
Karl-Behrendt-Weg 9 - 12 --> ergibt Hausnummer 12
Koitenh. Landstr. 11a-13b --> ergibt Hausnummer 1113
etc.

Es soll aber für jede Hausnummer ein eigener Wert (23,24,25) ausgegeben werden.

Daneben gibt es auch bei den Hausnummernzusätzen einige Gemeinheiten:

Karl-Behrendt-Weg 13a-C
Karl-Krull-Str. 19 a/b
Koitenh. Landstr. 11a-13b
Kooser Weg 4a,b, 5a,b

Auch hier soll für jede Adresse ein eindeutiger Wert (K-B-W 13 a, K-B-W 13 b, K-B-W 13 c) erzeugt werden.

Und weil das ja noch nicht genug ist, stellen auch unterschiedlichen Schreibweisen der Straßennamen ein Problem dar:

Karl-Krull-Str.
Karl-Krull-Straße
Koitenh. Landstr.
Koitenhaeg.Landstr.

Letzteres scheint mir das schwierigste Problem zu sein.

Können sie, als Experten, mir sagen wie aufwändig sich eine solch umfassende Standardisierung gestaltet und wer bei einer Umsetzung helfen könnte?

Vielen Dank, dass sie zumindest bis hierhin gelesen haben und vielleicht können sie mir ja weiterhelfen.

Mit den Besten Grüßen,
der Zonk

Adressen verwalten Office 2007
#2

Hallo,

etwas besseres als die erste Ziffer in einer Schleife zu suchen, ist mir auch nicht eingefallen.

Komplett würde das in VB6 bei mir etwas so aussehen wie im Code unten.
Den eigenen Typ, wie ich das zur Rückgabe von zei verschiedenen Strings aus der Funktion verwendet habe, kann VBA auch.

Sonst habe ich von VBA leider keine Ahnung.

Gruß Rainer

Private Type Strasse
 Str As String
 Nr As String
End Type

Private Function Teile(txt As String) As Strasse
 Dim pos As Integer, i As Integer
 pos = -1
 For i = 1 To Len(txt)
 If Asc(Mid(txt, i, 1)) \>= Asc("0") And Asc(Mid(txt, i, 1)) 0 Then
 Teile.Str = Left(txt, pos)
 Teile.Nr = Right(txt, Len(txt) - pos)
 Else
 Teile.Str = txt
 Teile.Nr = ""
 End If
End Function

Private Sub Command1\_Click()
 Dim Erg As Strasse
 Erg = Teile(Text1.Text)
 Label1.Caption = Erg.Str
 Label2.Caption = Erg.Nr
End Sub
#3

Hi Zonk,

Die Daten liegen in der Form vor, dass in einem Feld sowohl
Straßenname als auch Hausnummer mit Zusatz notiert sind.
Bsp.: Maierdorfstr. 16 B
Das Makro soll nun zum einen den Hausnummernzusatz und die
Hausnummer in ein neu angelegtes Feld kopieren.

Der Wunsch etwas zu programmieren was das 100,00 %ig umsetzt, wird nur in Ausnahmefällen gelingen, je nach zufälliger Mischung des Datensalates pro Stadt.

Wenn mna Zeit=Geld setzt so ist das vergleichbar mit einem Filter für einen Firmenschornstein. Soll er 90 % rausfiltern, so kostet er 10.000, bei 95 % schon 100.000, bei 96% dann 300.000, bei 97% dann 700.000, usw.

Mit deinem Code bist ja schon bei 85% oder so.

Besonders wenn du im Code noch den Fehler beseitigst :smile:

Schau mal auf die Filterung:
Karl-Behrendt-Weg 9 - 12 --> ergibt Hausnummer 12
und
ergibt Hausnummer 2325

Es soll aber für jede Hausnummer ein eigener Wert (23,24,25)
ausgegeben werden.

Wer legt das denn fest?
In Frankfurt sind die Häuser 23, 25, 27 nebeneinander, in Berlin 23, 23,25,26.
D,h wenn in F in einer Siedlung an einem Häuserblock dransteht 23-27 so heißt das 23, 25, 27.
In B. 23,24,25,usw.

Demzufolge muß man prüfen welche Stadt vorliegt.

Daneben gibt es auch bei den Hausnummernzusätzen einige
Gemeinheiten:

es gibt auch, schon in einer Firma mit so einer ähnlichen Adresse jahrelang gearbeitet, z.B.
Am Deichgraben o.Nr.
Sehr schwierig für ein Makro zu erkennen daß die Hausnummer „o.Nr.“ ist. Der Briefträger weiß das *gg*

Und weil das ja noch nicht genug ist, stellen auch
unterschiedlichen Schreibweisen der Straßennamen ein Problem
dar:

Mit das Schwierigste. Auch wenn das Originalstraßenverzeichnis der Stadt zum Vergleich vorläge liefe das auf einen Ähnlichkeitsvergleich hinaus, der auch nie 100%-ig klappt, siehe Software für Texterkennungssoftware.

Können sie, als Experten, mir sagen wie aufwändig sich eine
solch umfassende Standardisierung gestaltet und wer bei einer
Umsetzung helfen könnte?

Für das ganz komplizierte ein Auftragsprogrammierer.

Gruß
Reinhard

#4

Code beschleunigen
@Rainer, ich muß jetzt weg, Lüfter kaufen, magst du meine beiden, oder auch Code von dir testen welcher der schnellste ist?
Ich muß meine CPU schonen :smile:
Im Ernst, der CPU-Lüfter ist kaputt, habe ihn jetzt ausgebaut und das Gehäuse offen, anscheinend stabilisiert sich die CPU-Temparatur bei ±50 Grad. (bei geschlossenem Gehäuse waren es 69 Grad).
http://www.hostarea.de/server-01/Januar-0da6cd16e6.jpg
(Klasse Programm, runtergeladen von chip.de, installiert, bei Configure auf German gestellt und fertig, so liebe ich Freeware *gg*)

Hi Zonk,

es klingt ja so als ob da mehrere Städte mit 10.000 Datensätzen umgewandelt werden sollen.
Zum Codebeschleunigen, wenn bei
IF () And IF () THen
eine Bedingung falshc ist, so ist die Benutzung von zwei einzelnen IFs schneller.

Sub test()
MsgBox numbersOnly("abcd 0123456789")
End Sub
'
Function numbersOnly(strInput As String) As String
Dim x As Integer
For x = 1 To Len(strInput)
 If Mid(strInput, x, 1) "/" Then
 numbersOnly = numbersOnly & Mid(strInput, x, 1)
 End If
 End If
Next
End Function
'
Function numbersOnly2(strInput As String) As String
Dim x As Integer
For x = 1 To Len(strInput)
 If Asc(Mid(strInput, x, 1)) 47 Then
 numbersOnly = numbersOnly & Mid(strInput, x, 1)
 End If
 End If
Next
End Function

Gruß
Reinhard

#5

Tausend Dank für eure schnellen Antworten!
Hat mir sehr geholfen!

#6

Tausend Dank für eure schnellen Antworten!
Hat mir sehr geholfen!

Hi Zonk

http://excelformeln.de/formeln.html?welcher=350

dort in den Formeln findest du auch eine Formel die „12b“ in Zahl und Text aufteilt.

Wenn du willst bau ich dir die Formel auch in Excel-Vba nach, kein Akt.

Gruß
Reinhard

#7

Hallo Reinhard!
Erstmal danke für die Mühe.
Leider sind meine Programmierkenntnisse aufs minimalste beschränkt, wenns für dich kein Problem ist, würd ich mich sehr freuen, wenn du das übersetzen könntest.
Beste Grüße,
der Zonk

#8

Leider sind meine Programmierkenntnisse aufs minimalste
beschränkt, wenns für dich kein Problem ist, würd ich mich
sehr freuen, wenn du das übersetzen könntest.
Beste Grüße,

Hi Zonk,

Nachstehend ist der Code wo ich nur die im Link genannten Formeln umgesetzt habe.
Excelformeln sind bis zu 10000mal schneller als VB bzw. Vbacode, z.B. wenn man im Code jede Zelle einzeln auslesen/auswerten muß bei vielen Zeilen.
Deshalb schreibt man dann fix in eine Hifsspalte die Formeln rein, und ersetzt dann die Formeln durch deren Ergebnisse. das geht schnell.

Wenn du dir das anschaust:
„=LEFT(A1,FIND(“"#"",SUBSTITUTE(A1,"""",""#"",LEN(A1)-LEN(SUBSTITUTE(A1,"" „“,""""))))-1)"

und mit der Excelformel vergleichst
=LINKS(A1;FINDEN("#";WECHSELN(A1;"";"#";LÄNGE(A1)-LÄNGE(WECHSELN(A1;" „;“"))))-1)

erkennst du leicht wie man grundsätzlich eine Excelformel mittels Vba in Zellen schreiben kann.

Der Code geht davon aus daß in Spalte A die Strassennamen stehen,
das Ergebnis wird in Spalten B:F geschrieben, davon werden dann zwei Hilfsspalten gelöscht.
Also Code nicht laufen lassen wenn außer in A noch wichtige Daten drin stehen im **aktiven>/b> Blatt!

Tabellenblatt: [Mappe2]!Tabelle3
 │ A │ B │ C │ D │
──┼────────────────────────┼─────────────────────┼─────┼──────┤
1 │ Collenbachstr. 124 │ Collenbachstr. │ 124 │ │
──┼────────────────────────┼─────────────────────┼─────┼──────┤
2 │ Straße des 17. Juni 35 │ Straße des 17. Juni │ 35 │ │
──┼────────────────────────┼─────────────────────┼─────┼──────┤
3 │ Gartenstr. 12b │ Gartenstr. │ 12 │ b │
──┼────────────────────────┼─────────────────────┼─────┼──────┤
4 │ Kolpingstr. 4-6 │ Kolpingstr. │ 46 │ - │
──┼────────────────────────┼─────────────────────┼─────┼──────┤
5 │ am Stein VIII │ am Stein │ │ VIII │
──┴────────────────────────┴─────────────────────┴─────┴──────┘
A1:smiley:5
haben das Zahlenformat: Standard

Tabellendarstellung erreicht mit dem Code in FAQ:2363

In ein Standardmodul, z.B. Modul1:

Sub Test()
Dim Anz As Long
Anz = Cells(Rows.Count, 1).End(xlUp).Row
Range("B1:B" & Anz).Formula = "=LEFT(A1,FIND(""#"",SUBSTITUTE(A1,"" "",""#"",LEN(A1)-LEN(SUBSTITUTE(A1,"" "",""""))))-1)"
Range("C1:C" & Anz).Formula = "=RIGHT(A1,LEN(A1)-LEN(B1)-1)"
Range("D1:smiley:" & Anz).Formula = "=SUBSTITUTE(C1,E1,"""")"
Range("E1:E" & Anz).Formula = "=SUBSTITUTE(SUBSTITUTE(F1,8,""""),9,"""")"
Range("F1:F" & Anz).Formula = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(C1,0,""""),1,""""),2,""""),3,""""),4,""""),5,""""),6,""""),7,"""")"
Range("B1:F" & Anz).Value = Range("B1:F" & Anz).Value
Columns("C").Delete
Columns("E").Delete
Columns("A:smiley:").AutoFit
End Sub

Gruß
Reinhard**

#9

Hi Zonk,

nachstehender Code erzeugt die folgende Tabelle, Strassen namen werden in Tabelle1!A:A erwartet, Ausgabe dann in tabelle2!A:K.

Kannst j amal eine Mappe mit 10.000 Datensätzen hochladen per FAQ:2861 o.ä.
Dann kann man den Code anpassen.

Tabellenblatt: [Mappe1]!Tabelle2
 │ A │ B │ C │ D │ E │ F │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
1 │ Maierdorfstr. 16 │ Maierdorfstr. │ 16 │ │ │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
2 │ K.-Liebknecht-Ring 23-25 │ K.-Liebknecht-Ring │ 23 │ - │ 25 │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
3 │ Karl-Behrendt-Weg 9 - 12 │ Karl-Behrendt-Weg │ 9 │ - │ 12 │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
4 │ Koitenh. Landstr. 11a-13b │ Koitenh. Landstr. │ 11 │ a- │ 13 │ b │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
5 │ Karl-Krull-Str. │ Karl-Krull-Str. │ │ │ │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
6 │ Karl-Krull-Straße │ Karl-Krull-Straße │ │ │ │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
7 │ Koitenh. Landstr. │ Koitenh. Landstr. │ │ │ │ │
──┼───────────────────────────┼─────────────────────┼────┼─────┼────┼───┤
8 │ Koitenhaeg.Landstr. │ Koitenhaeg.Landstr. │ │ │ │ │
──┴───────────────────────────┴─────────────────────┴────┴─────┴────┴───┘
A1:F8
haben das Zahlenformat: Standard

Tabellendarstellung erreicht mit dem Code in FAQ:2363

Gruß
Reinhard

Sub Splitten()
Dim Zei As Long, B As Integer, Bereich, Z As Integer, Zahl As Boolean
With Worksheets("Tabelle1")
 Bereich = Range("A1:K" & Cells(Rows.Count, 1).End(xlUp).Row)
 For Zei = 1 To UBound(Bereich)
 B = 2
 For Z = 1 To Len(Bereich(Zei, 1))
 If InStr("0123456789", Mid(Bereich(Zei, 1), Z, 1)) \> 0 Then
 If Zahl = False And Z \> 1 Then B = B + 1
 Bereich(Zei, B) = Bereich(Zei, B) & Mid(Bereich(Zei, 1), Z, 1)
 Zahl = True
 Else
 If Zahl = True And Z \> 1 Then B = B + 1
 Bereich(Zei, B) = Bereich(Zei, B) & Mid(Bereich(Zei, 1), Z, 1)
 Zahl = False
 End If
 Next Z
 Next Zei
End With
With Worksheets("Tabelle2")
 .UsedRange.ClearContents
 .Range("A1:K" & Cells(Rows.Count, 1).End(xlUp).Row) = Bereich
 .Columns("A:K").AutoFit
End With
End Sub