Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 09:26:26
Median für Zeilen mit gleichen Zeitstempel
19.04.2024 08:41:23
Zwei Makros in ein Arbeitsblatt - zweite wird nicht ausführt
18.04.2024 21:09:11
4 Spalten aus smarter Tabelle in andere smarte Tab. kopieren
18.04.2024 20:45:35
Worksheet_Activate für alle Sheets
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1632to1636
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1632to1636
1632to1636
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Adresse splitten

Adresse splitten
12.07.2018 09:42:36
Franz
Hallo liebe Excelfreunde!
Ich habe eine unstrukturierte Adresstabelle, pro Adresse jeweils 3 Zeilen und eine Spalte.
Max Testmann
Teststraße 121 10001 Berlin
Tel: 011/1111111 Website: test.de E-mail: mail@test.de
Max Testmann
Teststraße 121 1000 NL Amsterdam
Tel: 11/1111111 E-mail: mail@test.nl
Würde nun mit Hilfe von euch eine Möglichkeit suchen, die Adresse in einer Zeile und in die Spalten:
Name-Straße-Ort-Tel-Webseite-Email
zu splitten. Mein Problem ist ein fehlendes Trennzeichen zwischen Straße und PLZ und dass in der Zeile mit Tel, Website und E-Mail nicht unbedingt all drei Daten vorhanden sein müssen.
PLZ kann 4 oder 5 stellig sein aber auch 4 stellig gefolgt von zwei Buchstaben (NL)
VBA Lösung bevorzugt, freue mich auf eure Hilfe,
lG Franz

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Adresse splitten
12.07.2018 13:29:47
Rob
Ist zwischen den Adresstabellen jeweils eine freie Zeile in der Spalte?
Ich würde erstmal die einzelnen Strings (Vorname, Name, Straße, Hausnummer, etc.) pro Zeile in jeweils eine Zelle aufteilen und anschließend in die erste Zeile kopieren:

Sub SplitAddressTable()
Dim r As Range
Dim i As Integer
With Tabelle1
'Pro Zeile Strings aufsplitten
Range("A1", Range("A1").End(xlDown)).TextToColumns _
Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1) _
), _
TrailingMinusNumbers:=True
'nach dem Nachnamen fortlaufend in die erste Zeile schreiben
Range("C1").Activate
For i = 2 To 3 'Zeile 2 und 3 der Adresstabelle
For Each r In Range("A" & i, Range("A" & i).End(xlToRight))
ActiveCell = r
ActiveCell.Offset(0, 1).Activate
Next r
Next i
End With
End Sub
Müsste man natürlich noch dynamisch anpassen, je nachdem wie Deine Tabelle aufgebaut ist.
Anzeige
AW: Adresse splitten
12.07.2018 16:21:29
Franz
Hallo Rob,
danke für deinen ersten Ansatz!
Die Adressen sind jeweils drei zeilig, gefolgt von einer Leerzeile.
Mit Text in Spalten wird zwar der String sauber bei jedem Leerzeichen getrennt, aber es werden dann die Daten in verschieden Spalten geschrieben. Besteht zB. ein Straßenname aus 2 Wörter werden auch 2 Spalten belegt. Die Datensätze von „Straße“ stehen demnach nicht immer in der richtigen Spate. Ebenso wenn bei einer Adresse die Mailadresse fehlt, werden die Daten spaltenmäßig nicht richtig zugeteilt.
Die Zeile mit Tel, Mail und Web kann ich mit
pos1 = InStr(strName, ":") 'Position erster Doppelpunkt
pos2 = InStr(pos1 + 1, strName, ":") 'Position zweiter DP
pos3 = InStr(pos2 + 1, strName, ":") 'Position dritter DP
ja noch sauber teilen und dann in die richten Spalten schreiben.
Für die Zeile „Straße PLZ und Ort“ würde mir vorschweben den String auf eine Zahl zu Überprüfen die größer ist als 1000 und da dann das Feld vor der PLZ splitten. Leider habe ich für diesen Lösungsansatz noch keinen brauchbaren Code zustande gebracht
LG und Hoffnung auf eure Hilfe
Franz
Anzeige
AW: Adresse splitten
12.07.2018 23:40:29
Rob
Ich habe den Code noch dynamisch angepasst, allerdings schreibt er wirklich jeden einzelnen String in eine separate Zelle. Ganz ehrlich; wenn das ne einmalige Geschichte ist, dann würde ich anschließend das Ergebnis manuell anpassen: Zusatzspalten einfügen, Daten/Filtern und dann Zellen für den gefilterten Bereich in den Zusatzspalten zusammenfügen.

Sub SplitAddressTable()
Dim r As Range
Dim i As Integer
Dim LastRow, Counter As Long
With Tabelle1
.Range("A1").Activate
Do While ActiveCell  ""
'Pro Zeile Strings aufsplitten
Range(ActiveCell, ActiveCell.End(xlDown)).TextToColumns _
Destination:=ActiveCell, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array( _
6, 1) _
), _
TrailingMinusNumbers:=True
ActiveCell.Offset(4, 0).Activate
Loop
'nach dem Nachnamen fortlaufend in die erste Zeile schreiben
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
Counter = 1
Dim Zeile2, Zeile3 As Integer
Zeile2 = 2
Zeile3 = 3
Do Until Counter = LastRow
.Cells(Zeile2 - 1, 3).Activate
For i = Zeile2 To Zeile3 'Zeile 2 und 3 der Adresstabelle
For Each r In .Range("A" & i, .Range("A" & i).End(xlToRight))
ActiveCell = r
ActiveCell.Offset(0, 1).Activate
Next r
Next i
.Cells(Zeile2, 1).EntireRow.ClearContents
.Cells(Zeile3, 1).EntireRow.ClearContents
Zeile2 = Zeile2 + 4
Zeile3 = Zeile3 + 4
Counter = Counter + 3
Loop
'Leeren Zeilen löschen
.UsedRange.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Anzeige
AW: Adresse splitten
12.07.2018 23:56:28
Rob
Achtung!!! Mach den Counter raus, sonst hast Du eine Endlosschleife drin. Ergänze dafür die letzte Do loop-Anweisung wie folgt:

Loop Until .Cells(Zeile2, 1) = ""
Sorry!
AW: Adresse splitten
13.07.2018 08:35:27
Franz
Hallo Rob,
danke für deine Mithilfe, das Aufteilen der Daten war schon mal eine Erleichterung, Rest habe ich mit einigen umständlichen Einzelaktionen in die richtige Form gebracht.
Danke nochmal und lG
Albert
AW: Areas
12.07.2018 16:36:15
Fennek
Hallo,
für den 1. Schritt sollte dieser Code helfen:

Sub T_1()
With ActiveSheet.UsedRange.Columns(1).SpecialCells(2)
For Each ar In .Areas
ar.Copy
Cells(Rows.Count, 5).End(xlUp).Offset(1).PasteSpecial Transpose:=True
Next ar
End With
End Sub
mfg
Anzeige
AW: Areas
12.07.2018 17:59:55
Franz
Hallo Fennek,
der erste Schritt funktioniert super, die drei Adresszeilen werden sauber in die drei Spalten geschrieben, Performance sehr schnell! Fehlt mir nur noch das Splitten der drei Spalten. Irgendwie fehlt mir die Logik, wie ich vor allem die Spalte mit Straße und PLZ richtig teilen kann.
Danke und lG
Franz
AW: split()
12.07.2018 18:24:59
Fennek
Hallo,
es sollte recht einfach sein:
- Fallunterscheide D und NL
- Fallunterscheidung mit/ohne Webseite
- split
mfg
(keine Lust zum Code-Schreiben)
AW: split()
13.07.2018 11:21:23
Franz
ist zwar nicht die feine englische Art, aber es teilt die Straße mit der PLZ
strName = Range("A1").Value
'Hausnummer
For iA = 1 To Len(strName)
If IsNumeric(Mid(strName, iA, 1)) Then Exit For
Next iA
For iE = iA To Len(strName)
If Not IsNumeric(Mid(strName, iE, 1)) Then Exit For
Next iE
iA_PLZ = iE + 1
iE = iE - iA
'strHNr = Mid(strName, iA, Len(strName) - (iE - iA))
strHNr = Mid(strName, iA, iE)
'Postleitzahl
iA = iA + iE
For iE = iA_PLZ To Len(strName)
If Not IsNumeric(Mid(strName, iE, 1)) Then Exit For
Next iE
iE = iE - iA_PLZ
strPLZ = Mid(strName, iA_PLZ, iE)
nochmals Danke
Franz
Anzeige
AW: Areas
12.07.2018 18:31:41
Rob
Weiteres Problem ist der Prefix NL für Niederlande...

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige