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

Hallo,

mit einem Makro kann man den Inhalt der zwei Zellen zusammenfügen. Aber für eine weitere Verarbeitung nutzt dir das nichts. Deshalb ist es sinnvoller Name, Kontakt- und Adressdaten in einzelne Zellen zu schreiben. Dann ist auch das Sortieren nach der Postleitzahl einfacher.

Also überleg dir das noch einmal mit alle Daten in eine Zelle schreiben.

Auch wäre eine Musterdatei mit ein paar Phantasiedaten nicht schlecht. Die kannst du z.B. hier einstellen und den Link dann posten.

Gruß

M.O.

Answer 2

also könnte ich die daten auch ordnen wenn sie über 2 zellen verteilt sind? kannst du mir erklären wie das geht?

ich nehm einfach mal den chef hier als testperson


Zelle A1 Fabian Gränzer, Supportnet GbR
Zelle A2 Gneiststr. 17,10437 Berlin, fax , tel.
Zelle A3 Leer
Zelle A4 hier dann der nächste name
Zelle A5 adresse, plz, fax uw..
Zelle A6 Leer

so zieht sich das ewig weiter.

1. Problem: ich weiß nicht wie ich den "Bezug" von Zelle A2 zu Zelle A1 herstellen kann. Damit die als "Eins" gesehen werden.
2. Problem: selbst wenn 1. Problem gelöst ist, weiß ich nicht wie ich nach der PLZ ordnen kann, da sie nicht einzlen in einer Zelle steht.
Würde sie das tun, müsste ich sie von hand abschreiben. das wäre verdammt viel Arbeit.

Gruß

Answer 3

hi pumuckel :-)

deine tabelle ist nicht schlecht ^^

sie ist eher peinlich :-))

dann nimm wenigstens die tips von mo auf und gestalte deine tabelle neu

gruss nighty

Answer 4

hi all :-)

dazu faellt mir wieder mein chef ein hihi

statt summe bereich zu nutzen war in der zelle wirklich

A1+A2+A3 ... usw

ich werd nochmal an herzinfakt sterben *g*

gruss nighty

Answer 5

Hallo,

ich habe dir mal ein Makro geschrieben, das die Daten zerlegt in ein neues Blatt schreibt. Voraussetzung ist, dass
[list]- deine Daten in Spalte A sind und bei 1 beginnen,
- nach zwei Zeilen immer eine Leerzeile kommt
- die einzelen Informationen durch ein Komma getrennt sind
- und die PLZ fünfstellig sind.[/list]

Kopiere das Makro in ein Modul deiner Arbeitsmappe und starte es von dem Blatt aus, in dem deine Daten stehen.

Sub Daten()

Dim i, wl, zeile, zn As Long
Dim ws, ts 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") = "Straße"
Worksheets("Daten neu").Range("D1") = "PLZ"
Worksheets("Daten neu").Range("E1") = "Ort"
Worksheets("Daten neu").Range("F1") = "Fax"
Worksheets("Daten neu").Range("G1") = "Telefon"


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


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

'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)

'zweite Zeile wird zerlegt
'Straße
wl = Len(Worksheets(ws).Cells(zeile + 1, 1))
For i = 1 To wl
If Mid(Worksheets(ws).Cells(zeile, 1), i, 1) = "," Then Exit For
Next i

Worksheets("Daten neu").Cells(zn, 3) = Left(Worksheets(ws).Cells(zeile + 1, 1), i - 2)
'Inhalt der Zelle wird ohne Ort gespeichert
ts = Right(Worksheets(ws).Cells(zeile + 1, 1), wl - i + 1)
wl = Len(ts)
'PLZ (5-Stellig)
Worksheets("Daten neu").Cells(zn, 4) = Left(ts, 5)
ts = Right(ts, wl - 6)
'Ort
For i = 1 To wl - 6
If Mid(ts, i, 1) = "," Then Exit For
Next i
Worksheets("Daten neu").Cells(zn, 5) = Left(ts, i - 1)

ts = Right(ts, wl - i - 7)

'Fax
wl = Len(ts)
For i = 1 To wl
If Mid(ts, i, 1) = "," Then Exit For
Next i

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

'Telefon
Worksheets("Daten neu").Cells(zn, 7) = Right(ts, wl - i - 1)


zn = zn + 1

Next zeile


End Sub

Deine Ursprungstabelle wird nicht geändert. Ein Blatt mit dem Namen "Daten neu", dort findest du dann das Ergebnis. Trotzdem solltest du das Makro zuerst nicht in der Orginaldatei testen.

Gruß

M.O.

Answer 6

Danke ich werd mich nochmal melden
wenn ich das
Makro getestet hab. Keine Ahnung
allerdings was
nighty meint

Answer 7

Hi,

bin gerade am Testen.

Sorry hatte nicht gedacht dass sich die einzelnen Infos so stark bei der Übername in die andere Tabelle unterscheiden.
so bräuchte ich es. PLZ u. Ort kann zusammenbleiben.

Ganz genau sehen die Daten so aus (sorry für die ungenauen Angaben, dachte das macht keinen Unterschied).

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

also nach der Ausgabe so:

Name Firma Telefon Fax Plz u. Ort Straße


Ü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 u. Ort"
Worksheets("Daten neu").Range("F1") = "Straße"

Spalte G wird durch PLZ u. Ort nicht mehr benötigt.
Diese Reihenfolge könnte ich nur per Hand ändern, muss die Daten so übernehmen.

Das Makro an sich ist schon sehr genau das was ich meinte,
wollte es gerade anpassen, aber irgendwie schaff ich das nicht.
Sind zuviele Dinge mit denen ich mich nicht auskennte, fängt schon bei den Variablen an und damit hörts auch auf.

Vermutlich lag es daran, dass ich nun doch eine andere Reihenfolge hatte als in meinem
Wollte das gerade anpassen, aber ich komme nicht ganz klar, weil in deinem Makro Ort und PLZ getrennt ausgelesen werden. Hab es jedenfalls getestet und es geht auch miteinander.

Bei einigen Adressen hab ich keine Faxnummer, die setzt ich dann eben von hand auf "Fax: 00000", sonst gibts Fehler bei der Ausgabe.

Dein Makro ist jedenfalls spitze, hätte ich anfangs schon genauere Infos gepostet, hätte ich jetzt schon die Lösung.
Wäre nett wenn du mir beim Anpassen noch helfen könntest.

Danke ;-)

Answer 8

Hallo,

hier das angepasste Makro. Falls keine Telefon- oder Faxnummer existiert wird 0000 in die Zeile geschrieben.

Sub Daten()

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

'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)

'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 Telefonnummer 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
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)

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

Next zeile


End Sub

Gruß

M.O.

Answer 9

Hey Klasse Arbeit,
Funktioniert soweit genau so wie es soll.
Hab beim Auführen des Makros allerdings gemerkt, dass Name und Firma nicht immmer durch ein komma getrennt sind. Kann ich dafür auch 0000 oder irgendeinen anderen Platzhalter eintragen lassen?

'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

da muss ich dann wohl was ändern. Ich kenn mich damit nicht so aus, aber da muss wohl noch ein Else hin oder?

Answer 10

Hallo,

ein Else ist nicht unbedingt notwendig :-) (siehe z.B. hier).

Hier der geänderte Code (mit Else :-))

Sub Daten()

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) = "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
'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
Worksheets("Daten neu").Cells(zn, 6) = Right(ts, Len(ts) - i - 1)

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

Next zeile


End Sub

Gruß

M.O.