Zellen 1 mit Inhalt von Zelle 2 zusätzlich füllen

Question

Hi,
Ich habe eine Tabelle mit Firmenadressen. Nun ist es so. in der Oberen Zeile steht der Name, in der direkt darunter steht die Tel.Nr. PLZ usw.
Also in etwa so:

Max Mustermann
Tel. 12345, Fax123456, Plz 12345 Ort.

Nun sollte die obere Zelle allerdings so aussehen:
Max Mustermann Tel. 12345, Fax123456, Plz 12345 Ort.
(die untere Zeile wäre dann also leer).

Ich könnte in B1 Natürlich =A1&" "&A2 schreiben dadurch käme ich auf das Ergebnis. und könnte Spalte A einfach ausblenden.
Aber Ich sollte die Daten am ende noch ordnen können. Was bei "=A1&" "&A2" oder =A50&" "&A51 nicht mehr funktioniert.

Möglich wäre eine Funktion, die einfach den Inhalt der unteren zeile, der oberen zeile anfügt. Makros oder so, damit kenn ich mich leider absolut nicht aus.

Ich könnte die Daten auch in anderes Programm kopieren, nur weiß ich nicht mit welchem ich das schaffen könnte.

Die Zeilen müssen am ende noch nach Postleitzahl geordnet werden, da steh ich dann schon vor dem nächsten Problem...

Wäre echt super wenn mir bei diesem Problem jemand helfen könnte.

Answer 1

Moin, genau super

nächstes Problem. gibt nicht immer eine Straßenangabe.

habs gerade selbst getestet aber dann wird mir
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)
als Fehler angezeigt.

Ich glaub dann müsste ich die Suche nach dem Komma nach PLZ und Ort verändern?
Dann evtl doch ein Else oder?

Answer 2

Hallo,

ändere im Makro

'Straße
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)

in

'Straße
If Len(ts) <= i Then
Worksheets("Daten neu").Cells(zn, 6) = "kein Eintrag vorhanden"
Else
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)
End If

Gruß

M.O.

Answer 3

sorry noch ein problem. hab die entsprechende zeile geändert und das Makro weiter ausgeführt, jetzt meckert Excel, ich hab Zwar in der betreffenden Zeile eine Telefonnummer, aber keine FAX-Nr. Jetzt hat er die PLZ+Ort in die Zelle von der FAX-Nr geschrieben. Ergo steht nun bei PLZ+Ort die Straße, somit bleibt die Zelle für die Straße leer. Da das Ganze später nach PLZ sortiert wird, kann das mit der Straße natürlich nicht funktionieren. Aber ich glaub da gibts keine Richtige lösung. da ein " / " ja nicht als zahl gilt, somit kann man das wohl höchstens über die Anzahl der Zahlen/Buchstaben filtern, falls das überhaupt geht.

Answer 4

Hallo,

normalerweise erkennt das Makro, wenn keine Telefon- oder Faxnummer vorhanden ist und schreibt 0000 in die jeweilige Zelle. Voraussetzung ist, dass die einzelnen Teile durch ein Komma getrennt sind.

Wenn keine Telefon- oder Faxnummer vorhanden sind, sollte der Datensatz so aussehen:
Max Mustermann, Musterfirma1 GmbH
Telefon: , Fax: 012345/678911, 12345 Musterhausen, Musterstraße 2

Falls die Datensätze ohne Telefon und Fax anders aussehen, so muss man wissen wie, damit das eventuell abfangen kann.

Wenn du willst, dass bei fehlender Telefon- oder Faxnummer ein "/" in das Feld geschrieben wird, dann ändere das im Makro.

Gruß

M.O.

Answer 5

Ich versteh es auch nicht,

Wenne s keine Tel.-Nr. gibt, funktioniert das mit den 0000 einfwandfrei.
Gibt es allerdings keine Fax-Nr. wird die PLZ wohl als Nummer erkannt.

Falls es z.B. dazu kommt.
name, firma
Tel.Nr., plz+Ort

dann wird nur die erste zeile (wie es sein soll) und Tel.Nr. übernommen.

Allerdings widerspricht sich das mit der Ausgabe von anderen Datensätzen.

so sieht eine Anschrift aus bei der die "0000" nicht in die Zelle für Fax geschrieben werden.

Name, Firma
Telnr, PLZ+Ort, Straße

PLZ+Ort rutscht nach links in die Zelle für Fax-Nr. die Straße in die Zelle für PLZ+Ort.
die Zelle für Straße bleibt logischer Weise frei.

So sieht das verwendete Makro aus:

Sub neu()
Dim i, wl, zeile, zn As Long
Dim ws, ts, tel As String

ws = ActiveSheet.Name
zn = 2

'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen
ActiveSheet.Name = "Daten neu"

'Überschriften im neuen Arbeitsblatt
Worksheets("Daten neu").Range("A1") = "Name"
Worksheets("Daten neu").Range("B1") = "Firma"
Worksheets("Daten neu").Range("C1") = "Telefon"
Worksheets("Daten neu").Range("D1") = "Fax"
Worksheets("Daten neu").Range("E1") = "PLZ + Ort"
Worksheets("Daten neu").Range("F1") = "Straße"


'Daten werden in das Zielblatt geschrieben
For zeile = 1 To Worksheets(ws).UsedRange.SpecialCells(xlCellTypeLastCell).Row Step 3

'Hier wird das Komma in der ersten Zeile gesucht
wl = Len(Worksheets(ws).Cells(zeile, 1))
For i = 1 To wl
If Mid(Worksheets(ws).Cells(zeile, 1), i, 1) = "," Then Exit For
Next i

If i >= wl Then
'kein Komma in Zeile gefunden
Worksheets("Daten neu").Cells(zn, 1) = Worksheets(ws).Cells(zeile, 1)
Worksheets("Daten neu").Cells(zn, 2) = "keine"
Else
'Name und Firma aus 1. Zeile werden ins neue Blatt übertragen
Worksheets("Daten neu").Cells(zn, 1) = Left(Worksheets(ws).Cells(zeile, 1), i - 1)
Worksheets("Daten neu").Cells(zn, 2) = Right(Worksheets(ws).Cells(zeile, 1), wl - i - 1)
End If

'zweite Zeile wird zerlegt
'Telefonnummer wird ermittelt
'1. Komma nach Telefonnummer wird gesucht
wl = Len(Worksheets(ws).Cells(zeile + 1, 1))
For i = 1 To wl
If Mid(Worksheets(ws).Cells(zeile + 1, 1), i, 1) = "," Then Exit For
Next i
'Hier wird die Telefonnummer mit Telefon in Variable geschrieben
tel = Left(Worksheets(ws).Cells(zeile + 1, 1), i - 1)
'Hier wird der restliche Inhalt in Variable geschrieben
ts = Right(Worksheets(ws).Cells(zeile + 1, 1), wl - i - 1)

'Hier wird die reine Telefonnummer gesucht
For i = 1 To Len(tel)
If IsNumeric(Mid(tel, i, 1)) = True Then Exit For
Next i
'Telefonnummer wird in Zeile geschrieben
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt

If Mid(tel, i, 1) = "" Then
'Falls keine Zahl gefunden wird, wird 0000 eingefügt
Worksheets("Daten neu").Cells(zn, 3) = "'0000"
Else
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt
Worksheets("Daten neu").Cells(zn, 3) = "'" & Right(tel, Len(tel) - i + 2)
End If


'Fax-Nummer
wl = Len(ts)
For i = 1 To wl
If Mid(ts, i, 1) = "," Then Exit For
Next i
'Hier wird die Fax_Nummer in Variable geschrieben
tel = Left(ts, i - 1)
'Hier wird der restliche Inhalt in Variable geschrieben
ts = Right(ts, wl - i - 1)

'Hier wird die reine Fax-Nummer gesucht
For i = 1 To Len(tel)
If IsNumeric(Mid(tel, i, 1)) = True Then Exit For
Next i

'Fax-Nr. wird in Zeile geschrieben
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt
If Mid(tel, i, 1) = "" Then
'Falls keine Zahl gefunden wird, wird 0000 eingefügt
Worksheets("Daten neu").Cells(zn, 4) = "'0000"
Else
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt
Worksheets("Daten neu").Cells(zn, 4) = "'" & Right(tel, Len(tel) - i + 1)
End If

'PLZ & Ort - Komma wird gesucht
wl = Len(ts)
For i = 1 To wl
If Mid(ts, i, 1) = "," Then Exit For
Next i

Worksheets("Daten neu").Cells(zn, 5) = Left(ts, i - 1)

'Straße - Komma wird gesucht
'Straße
If Len(ts) <= i Then
Worksheets("Daten neu").Cells(zn, 6) = "keine"
Else
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)
End If

'Zeilennummer für Zielblatt wird erhöht
zn = zn + 1

Next zeile

End Sub

Answer 6

Hallo,

bevor ich hier weiter im Trüben herumstochere, jetzt mal Butter zu de Fisch:

Wie sehen die Datensätze denn wirklich aus?

Etwa so:

Max Mustermann, Musterfirma GmbH
Telefon: , Fax: 012345/678911, 12345 Musterhausen, Musterstraße 2

oder so:

Max Mustermann, Musterfirma GmbH
Fax: 012345/678911, 12345 Musterhausen, Musterstraße 2

oder wie sonst?

Gib mir mal ein paar Musterdatensätze (wie meine Beispiele oben), wie sie wirklich in deiner Datei stehen - vor allem wenn einzelne Angaben fehlen - und nicht nur

Name, Firma
Telnr, PLZ+Ort, Straße

Gruß

M.O.

Answer 7

Ich fass es mal zusammen


Max Mustermann, Musterfirma GmbH
Telefon: , Fax: 012345/678911, 12345 Musterhausen, Musterstraße 2

Erste Zeile: kein Problem
Zweite Zeile:
Telefon: passt, falls nicht vorhanden wird mit 0000 ersetzt.
Fax: PLZ+Ort wird geschrieben falls keine Fax-Nr.
PLZ+Ort: passt, die Angabe fehlt nie
Straße: passt, falls nicht vorhanden wird mit "kein" ersetzt

Ist also die Fax-Nr. bei der die "0000" nicht geschrieben wird

Testdatensätze mit denen es funktioniert (ich schreib in der oberen zeile mal nur den Namen, weil es damit nie Probleme gibt:

Max Mustermann, Musterfirma GmbH
Telefon: , Fax: 012345/678911, 12345 Musterhausen, Musterstraße 2

Max Mustermann
, Fax: 012345/67890, 12345 Musterstadt, Musterweg. 3

Datensätze bei denen es nicht funktioniert:
Max Mustermann
12345 Musterstadt
(untere Zeile wird nicht übernommen, wegen fehlendem Komma)

Max Mustermann
, 12345 Musterstadt
(PLZ+Ort wird in Zelle für Telefonnummer geschrieben).

Max Mustermann
, Fax: 074449954, Musterweg. 3
(Musterweg 3 wird als PLZ übernommen, aber die PLZ gibt es wie gesagt immer


Max Mustermann
, Musterweg. 3

(in Zelle für Tel.Nr. werden "0000" geschrieben, Rest bleibt leer. Gilt nur als Test, da es PLZ immer gibt.)



Imho gibt es ein Problem bei der Variable für Fax.Nr. da PLZ+Ort nie als Telefonnummer übernommen wird.

Answer 8

Hallo,

deine Datensätze sind überhaupt nicht homogen, was die ganze Sache schwieriger macht. Ich schau mal, wie man das mit den unvollständigen Datensätzen lösen kann.

Gruß

M.O.

Answer 9

Hallo,

kopiere die folgenden Makros in ein Modul. Zum Übertragen der Daten musst du nur das Makro "Daten_neu" ausführen:

Public pruef, telf, fax, ort, strasse As String

Sub Daten_neu()

Dim d, i, k, wl, zeile As Long
Dim ws, ts As String
Dim wsh As Worksheet


ws = ActiveSheet.Name
zn = 2

'Prüfen ob Name des neu anzulegenden Arbeitsblattes ggf. schon vorhanden ist
For Each wsh In Worksheets
If wsh.Name = "Daten neu" Then
MsgBox "Ein Arbeitsblatt mit den Namen Daten neu existiert bereits! Makro wird beendet!", 16, "Fehlermeldung"
Exit Sub
End If
Next wsh

'Neues Blatt wird am Ende eingefügt
Worksheets.Add After:=Worksheets(Worksheets.Count)
'Neues Blatt benennen
ActiveSheet.Name = "Daten neu"

'Überschriften im neuen Arbeitsblatt
Worksheets("Daten neu").Range("A1") = "Name"
Worksheets("Daten neu").Range("B1") = "Firma"
Worksheets("Daten neu").Range("C1") = "Telefon"
Worksheets("Daten neu").Range("D1") = "Fax"
Worksheets("Daten neu").Range("E1") = "PLZ + Ort"
Worksheets("Daten neu").Range("F1") = "Straße"


'Daten werden in das Zielblatt geschrieben
For zeile = 1 To Worksheets(ws).UsedRange.SpecialCells(xlCellTypeLastCell).Row Step 3

'Variablen für Telefon etc. werden für den Durchlauf geleert
telf = ""
fax = ""
ort = ""
strasse = ""

'Hier wird das Komma in der ersten Zeile gesucht
wl = Len(Worksheets(ws).Cells(zeile, 1))
For i = 1 To wl
If Mid(Worksheets(ws).Cells(zeile, 1), i, 1) = "," Then Exit For
Next i

If i >= wl Then
'kein Komma in Zeile gefunden
Worksheets("Daten neu").Cells(zn, 1) = Worksheets(ws).Cells(zeile, 1)
Worksheets("Daten neu").Cells(zn, 2) = "nicht vorhanden"
Else
'Name und Firma aus 1. Zeile werden ins neue Blatt übertragen
Worksheets("Daten neu").Cells(zn, 1) = Left(Worksheets(ws).Cells(zeile, 1), i - 1)
Worksheets("Daten neu").Cells(zn, 2) = Right(Worksheets(ws).Cells(zeile, 1), wl - i - 1)
End If

'zweite Zeile wird zerlegt

'Zähler für Kommata wird auf Null gesetzt
k = 0
'Zeile 2 wird in Variable eingelsen
ts = Worksheets(ws).Cells(zeile + 1, 1)

'Länge des Datensatzes wird ermittelt
wl = Len(ts)

'Anzahl der Kommata wird ermittelt
For i = 1 To wl
If Mid(ts, i, 1) = "," Then k = k + 1
Next i

'Falls kein Komma vorhanden
If k = 0 Then
pruef = ts
Call pruefen

End If

'Falls nur ein Komma vorhanden
If k = 1 Then
'Komma suchen
For i = 1 To wl
If Mid(ts, i, 1) = "," Then Exit For
Next i

pruef = Right(ts, wl - i - 1)
Call pruefen

End If

'Falls mehrere Kommata vorhanden
If k > 1 Then
For d = 1 To k + 1
'Komma suchen
wl = Len(ts)
For i = 1 To wl
If Mid(ts, i, 1) = "," Then Exit For
Next i

If i >= wl Then
'Komma am Ende des Datensatzes wird ggf. entfernt
If Right(ts, 1) = "," Then ts = Left(ts, wl - 1)
pruef = Right(ts, Len(ts))
Else
pruef = Left(ts, i - 1)
ts = Right(ts, wl - i - 1)
End If

Call pruefen

Next d

End If

'Daten werden in Arbeitsblatt geschrieben
If telf = "" Then
Worksheets("Daten neu").Cells(zn, 3) = "'0000"
Else
Worksheets("Daten neu").Cells(zn, 3) = telf
End If

If fax = "" Then
Worksheets("Daten neu").Cells(zn, 4) = "'0000"
Else
Worksheets("Daten neu").Cells(zn, 4) = fax
End If

If ort = "" Then
Worksheets("Daten neu").Cells(zn, 5) = "keine Angabe"
Else
Worksheets("Daten neu").Cells(zn, 5) = ort
End If

If strasse = "" Then
Worksheets("Daten neu").Cells(zn, 6) = "keine Angabe"
Else
Worksheets("Daten neu").Cells(zn, 6) = strasse
End If

'Zeilennummer für Zielblatt wird erhöht
zn = zn + 1

Next zeile

End Sub



Sub pruefen()

Dim a As Long

'Prüfen ob Telefonnummer vorliegt

If Left(pruef, 7) = "Telefon" Then

'Hier wird die reine Telefonnummer gesucht
For a = 1 To Len(pruef)
If IsNumeric(Mid(pruef, a, 1)) = True Then Exit For
Next a
'Telefonnummer wird in Variable geschrieben
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt
If a < Len(pruef) Then telf = "'" & Right(pruef, Len(pruef) - a + 1)
Exit Sub

End If


'Prüfen ob Fax-Nummer vorliegt
If Left(pruef, 3) = "Fax" Then

'Hier wird die reine Fax-Nummer gesucht
For a = 1 To Len(pruef)
If IsNumeric(Mid(pruef, a, 1)) = True Then Exit For
Next a
'Fax-Nummer wird in Variable geschrieben
'Hochkomma wird eingefügt, damit führende Null erhalten bleibt
If a < Len(pruef) Then fax = "'" & Right(pruef, Len(pruef) - a + 1)
Exit Sub

End If

'Prüfen ob PLZ + Ort vorliegt
If IsNumeric(Left(pruef, 5)) = True Then
ort = pruef
Exit Sub
End If

'Straße
strasse = pruef


End Sub

Gruß

M.O.

Answer 10

Wow echt super. Danke hat genau so funktioniert wie ich wollte.
Echt spitze dass es noch so Genies wie dich gibt. Ich hätte das nichtmal
ansatzweise hinbekommen.
Hast mir echt viel Arbeit erspart. Das gute an den Platzhalter ist jetzt, dass ich
die noch verändern kann, oder gleich seh wenn was fehlt. Echt toll

gruß und schönes Wochenende