Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.
Clever-Excel-Forum › Office-Anwendungen › Excel v
Straßendaten bereinigen VBA

Thema geschlossen 
Baumstrukturmodus
Straßendaten bereinigen VBA
lycom87 Offline
CEF Einsteiger
*
Registriert seit: 31.08.2016
Version(en): Office 2013
#1
14.09.2016, 12:38
Hallo Zusammen,
ich habe einen Datensatz (Straßenliste) in der stehen die Straßen in allen Varianten mit Hausnummern.
Beispiele:
10, NEUTURMSTRASSE
12-14 MAXIMILIAN STRASSE
2 DEPT. STORE NEUHAUSER STRASSE 18
ALTE AKADEMIE*NEUHAUSER STRA?E 8-10
AMALIENSTR.24 RGB.
ARNULFSTR. 61-71
AUGUSTENSTR. 3 LADENGESCHAEFT
BAYERSTRASSE 3-5/EINGANG ZWEIGSTR.5
ERZGIESSEREISTR. 24/III
LANDSBERGER STR. 234 C, 1.OG

Hat jemand eine Idee wie ich evtl mit VBA mit den Straßenendungen (Str, Weg, etc....) eiine Textsuche machen kann...?
Suchen
Antworten Top
Jockel Offline
VUP & {Formelsympathisant}
Registriert seit: 10.04.2014
Version(en): Office 2019
#2
14.09.2016, 13:53
Hallo, nur zur Info..: http://www.ms-office-forum.de/forum/show...p?t=335531
Gruß Jörg
ich muss mich erst wieder ganz langsam heran robben. Also bitte ich um Nachsicht

"Wer immer tut, was er schon kann, bleibt immer das, was er schon ist." - Henry Ford
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#3
14.09.2016, 13:55
Hallo,

ich habe die Angewohnheiğt solche Aufgaben immer in einer kopierten Datei zu bearbeiten. Schutz for Datenverlust.

anbei ein kleines Makro mit dem man alle Arten von ;Strassen suchen und sich seitlich in 2 Spalten weiter notieren kann. Diese Spalten müssen natürlich frei sein. Oder den Offset von Offset(0, 2) auf (0, n) erhöhen. Sinn macht es wenn man vorher in Spalte A eine fortlaufende Lauf-Nr einfügt, sich Button zum Sortieren anlegt, und den Datensatz nach Strasse sortiert. Die Lauf-Nr braucht man zum Zurück-Sortieren. Damit findet man all Arten der Strassenangabe. Beim Sortieren blieben die Arten, die man nicht im Mkaro erfasst hat ja übrig. Deshalb sortiere ich gerne zur Kontrolle.

mfg  Gast 123

Code:
Option Explicit      '14.9.2016   Gast 123   für Clever Forum

Const Bereich = "A2:A13"   'deinen Such Bereich angeben

'Modul zum "STRASSE" auflisten

Sub Strassen_ausfiltern()
Dim AC As Object, Label As String
  For Each AC In Range(Bereich)
     Label = Empty   'Label löschen
     
     'STRASSE
     If InStr(AC, " STRASSE") Then
        Label = "  STRASSE"
        AC.Offset(0, 2) = "  STRASSE"
     ElseIf InStr(AC, "STRASSE") Then
        Label = " STRASSE"
        AC.Offset(0, 2) = "STRASSE"
     End If
     
     'STRA?E
     If InStr(AC, " STRA?E") Then
        Label = "  STRA?E"
        AC.Offset(0, 2) = "  STRA?E"
     ElseIf InStr(AC, "STRA?E") Then
        Label = " STRA?E"
        AC.Offset(0, 2) = "STRA?E"
     End If
   
     'STR. mit Punkt
     If InStr(AC, " STR.") Then
        Label = Label & ",  STR."
        AC.Offset(0, 2) = "  STR."
     ElseIf InStr(AC, "STR.") Then
        Label = Label & ",STR."
        AC.Offset(0, 2) = "STR."
     
     'STR  (ohne Punkt)
     If InStr(AC, "STRASSE") = 0 Then
     ElseIf InStr(AC, "STR.") Then
     ElseIf InStr(AC, " STR") Then
        Label = Label & ",  STR"
        AC.Offset(0, 2) = "  STR"
     ElseIf InStr(AC, "STR") Then
        Label = Label & ",STR"
        AC.Offset(0, 2) = "STR"
     End If
     End If
     
     If InStr(AC, " WEG") Then
        Label = Label & ",  WEG"
        AC.Offset(0, 2) = "  WEG"
     ElseIf InStr(AC, "WEG") Then
        Label = Label & ",WEG"
        AC.Offset(0, 2) = "WEG"
     End If
       
     'GASSE
     If InStr(AC, " GASSE") Then
        Label = Label & ",  GASSE"
        AC.Offset(0, 2) = "  GASSE"
     ElseIf InStr(AC, "GASSE") Then
        Label = Label & ",GASSE"
        AC.Offset(0, 2) = "GASSE"
     End If
       
     'ALLEE
     If InStr(AC, " ALLEE") Then
        Label = Label & ",  ALLEE"
        AC.Offset(0, 2) = "  ALLEE"
     ElseIf InStr(AC, "ALLEE") Then
        Label = Label & ",ALLEE"
        AC.Offset(0, 2) = "ALLEE"
     End If
 
     'CHAUSSE
     If InStr(AC, " CHAUSSE") Then
        Label = Label & ",  CHAUSSE"
        AC.Offset(0, 2) = "  CHAUSSE"
     ElseIf InStr(AC, "CHAUSSE") Then
        Label = Label & ",CHAUSSE"
        AC.Offset(0, 2) = "CHAUSSE"
     End If
 
     '1. Komma in Label abschneiden
     Label = Trim(Mid(Label, 2, 100))
     
     'auflisten wenn 2. Strasse in Label
     If InStr(Label, ",") Then
        AC.Offset(0, 2).Cells(1, 2) = Label
     End If
  Next AC
End Sub
[-] Folgende(r) 1 Nutzer sagt Danke an Gast 123 für diesen Beitrag:
  • lycom87
Suchen
Antworten Top
radagast Offline
Janosch
Registriert seit: 15.04.2014
Version(en): 2007, 2010, 2019
#4
14.09.2016, 14:20
excelfreunde, gast123,

den teil im makro bitte anpassen:

Code:
     'CHAUSSEE
     If InStr(AC, " CHAUSSEE") Then
        Label = Label & ",  CHAUSSEE"
        AC.Offset(0, 2) = "  CHAUSSEE"
     ElseIf InStr(AC, "CHAUSSEE") Then
        Label = Label & ",CHAUSSEE"
        AC.Offset(0, 2) = "CHAUSSEE"
     End If
Vielen Dank
--Janosch
                                                     
Excel  2019 (64bit)  Win 10 Pro (64bit)                              
[-] Folgende(r) 1 Nutzer sagt Danke an radagast für diesen Beitrag:
  • lycom87
Suchen
Antworten Top
lycom87 Offline
CEF Einsteiger
ThreadStarter
*
Registriert seit: 31.08.2016
Version(en): Office 2013
#5
14.09.2016, 14:29
(14.09.2016, 13:55)Gast 123 schrieb: Hallo,

ich habe die Angewohnheiğt solche Aufgaben immer in einer kopierten Datei zu bearbeiten. Schutz for Datenverlust.

anbei ein kleines Makro mit dem man alle Arten von ;Strassen suchen und sich seitlich in 2 Spalten weiter notieren kann. Diese Spalten müssen natürlich frei sein. Oder den Offset von Offset(0, 2) auf (0, n) erhöhen. Sinn macht es wenn man vorher in Spalte A eine fortlaufende Lauf-Nr einfügt, sich Button zum Sortieren anlegt, und den Datensatz nach Strasse sortiert. Die Lauf-Nr braucht man zum Zurück-Sortieren. Damit findet man all Arten der Strassenangabe. Beim Sortieren blieben die Arten, die man nicht im Mkaro erfasst hat ja übrig. Deshalb sortiere ich gerne zur Kontrolle.

mfg  Gast 123

Code:
Option Explicit      '14.9.2016   Gast 123   für Clever Forum

Const Bereich = "A2:A13"   'deinen Such Bereich angeben

'Modul zum "STRASSE" auflisten

Sub Strassen_ausfiltern()
Dim AC As Object, Label As String
  For Each AC In Range(Bereich)
     Label = Empty   'Label löschen
     
     'STRASSE
     If InStr(AC, " STRASSE") Then
        Label = "  STRASSE"
        AC.Offset(0, 2) = "  STRASSE"
     ElseIf InStr(AC, "STRASSE") Then
        Label = " STRASSE"
        AC.Offset(0, 2) = "STRASSE"
     End If
     
     'STRA?E
     If InStr(AC, " STRA?E") Then
        Label = "  STRA?E"
        AC.Offset(0, 2) = "  STRA?E"
     ElseIf InStr(AC, "STRA?E") Then
        Label = " STRA?E"
        AC.Offset(0, 2) = "STRA?E"
     End If
   
     'STR. mit Punkt
     If InStr(AC, " STR.") Then
        Label = Label & ",  STR."
        AC.Offset(0, 2) = "  STR."
     ElseIf InStr(AC, "STR.") Then
        Label = Label & ",STR."
        AC.Offset(0, 2) = "STR."
     
     'STR  (ohne Punkt)
     If InStr(AC, "STRASSE") = 0 Then
     ElseIf InStr(AC, "STR.") Then
     ElseIf InStr(AC, " STR") Then
        Label = Label & ",  STR"
        AC.Offset(0, 2) = "  STR"
     ElseIf InStr(AC, "STR") Then
        Label = Label & ",STR"
        AC.Offset(0, 2) = "STR"
     End If
     End If
     
     If InStr(AC, " WEG") Then
        Label = Label & ",  WEG"
        AC.Offset(0, 2) = "  WEG"
     ElseIf InStr(AC, "WEG") Then
        Label = Label & ",WEG"
        AC.Offset(0, 2) = "WEG"
     End If
       
     'GASSE
     If InStr(AC, " GASSE") Then
        Label = Label & ",  GASSE"
        AC.Offset(0, 2) = "  GASSE"
     ElseIf InStr(AC, "GASSE") Then
        Label = Label & ",GASSE"
        AC.Offset(0, 2) = "GASSE"
     End If
       
     'ALLEE
     If InStr(AC, " ALLEE") Then
        Label = Label & ",  ALLEE"
        AC.Offset(0, 2) = "  ALLEE"
     ElseIf InStr(AC, "ALLEE") Then
        Label = Label & ",ALLEE"
        AC.Offset(0, 2) = "ALLEE"
     End If
 
     'CHAUSSE
     If InStr(AC, " CHAUSSE") Then
        Label = Label & ",  CHAUSSE"
        AC.Offset(0, 2) = "  CHAUSSE"
     ElseIf InStr(AC, "CHAUSSE") Then
        Label = Label & ",CHAUSSE"
        AC.Offset(0, 2) = "CHAUSSE"
     End If
 
     '1. Komma in Label abschneiden
     Label = Trim(Mid(Label, 2, 100))
     
     'auflisten wenn 2. Strasse in Label
     If InStr(Label, ",") Then
        AC.Offset(0, 2).Cells(1, 2) = Label
     End If
  Next AC
End Sub

Hallo,
schaut schon mal spannend aus ::)  
kannst du mir das bitte einbauen ich bekomme es irgendwie nicht hin .

1000 Dank!!!


Angehängte Dateien
.xlsm   Straße VBA.xlsm (Größe: 82,12 KB / Downloads: 4)
Suchen
Antworten Top
Gast 123 Offline
Benutzer
Registriert seit: 12.03.2016
Version(en): Excel 2003
#6
15.09.2016, 00:20
Hallo

anbei die Beispieldatei mit erweitertem Makro für Strasse und Sortiermarko zurück. Man bekommt durch das Sortieren mehr Übersicht. Einige Fehler die ich erkannte werden als eigener Begriff ausgefiltert, wie z.B. GmbH anstatt Strasse. Beim speichern meckerte mein PC das er nicht alles speichern konnte. Aktive Steuerelemente könnten fehlen  (Excel 2007)  Die Makros laufen aber.

Bei Strasse unterscheide ich Strasse direkt am Wort, ohne Leerzeichen, und Strasse oder Weg etc. mit Leerzeichen.  Eindeutige Fehler wie "STZR" oder "ASSE" sind in der Fehlerspalte erfasst. 

mfg  Gast 123


Angehängte Dateien
.xlsm   Straße VBA 2.xlsm (Größe: 149 KB / Downloads: 2)
Suchen
Antworten Top
Thema geschlossen 


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste