Office: Zellen verketten und Formatierung beibehalten

Hemhol · 1. Januar 2007

Hallo,

ich habe 2 Spalten welche ich in einer 3 Spalte verketten möchte und dabei die unterschiedliche Formatierung der ersten beiden Spalte in die dritte übertragen möchte. Zusätzlich soll in der verketteten Spalte ein Zeilenumbruch eingefügt werden. Geht das in Excel irgendwie oder muß man das per VBA erstellen?
Wie geht so was?

Danke im voraus

Hemhol

:)

User · 2. Januar 2007

Moin Hemhol,

das mag sicherlich mit einem gewissen Aufwand irgendwie funktionieren, aber Du bist sicherlich um einiges schneller, wenn Du die Texte einfach in einzelne Zellen untereinander schreibst und jenen unterschiedliche Formatierungen gibst.

Hemhol · 3. Januar 2007

Das wäre natürlich am leichtesten, aber die Verkettete Zelle wird danach in eine Vorlage kopiert, in welchem sie in einer Zelle stehen muss.

Schmali · 3. Januar 2007

Hoi,

das dürfte auch nicht das Problem sein.

Zelle(n) markieren, Strg+C, rechte Maustaste (dort wo sie hinkopiert werden soll), Inhalte einfügen.., Werte (oder Werte und Zahlenformate).

Greetz

Schmali

Hemhol · 3. Januar 2007

Nö, geht leider nicht. Habe außerdem ein flexibles Dokument. Brauche irgendein Code in der Form:

C1= A1 & chr(10)& B1 + Übernahme der unterschiedlichen Formatierungen von A1 und B1 in C1.
(Spalte A ist immer fett; Spalte B hat bis zu 15 Zeilenumbrüche, mal ist manches fett, mal was unterstrichen....)

Gruß

losgehts · 3. Januar 2007

Hi Hemhol!
Vorwerg die Warnung: der Code ist absolut langsam!!
Ich hatte keine bessere Idee, als es Buchstabenweise zu machen*bawling .

Ich hatte Deine angehängte Datei zuerst nicht gesehen. Daher so viel auskommentiertes im Code, ich denke aber dass Du das auskommentierte evtl. doch brauchen kannst.
Code:

Sub übernehmen()
Dim i As Integer
Dim lngZeile As Long
For lngZeile = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'Schleife über alle Zeilen
If IsEmpty(Cells(lngZeile, 1)) = True Or IsEmpty(Cells(lngZeile, 2)) = True Then GoTo NächsteZeile

Cells(lngZeile, 3).Value = Cells(lngZeile, 1).Value & Chr(10) & Cells(lngZeile, 2).Value

'Buchstabenweise wird die Formatierung übernommen:

With Cells(lngZeile, 3)
'ColorIndex:
For i = 1 To Len(Cells(lngZeile, 1).Text)
.Characters(Start:=i, Length:=1).Font.ColorIndex = _
Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.ColorIndex
Next
For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
.Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.ColorIndex = _
Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.ColorIndex
Next
' 'Font.Name:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.Name = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Name
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Name = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Name
' Next
'FontStyle:
For i = 1 To Len(Cells(lngZeile, 1).Text)
.Characters(Start:=i, Length:=1).Font.FontStyle = _
Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.FontStyle
Next
For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
.Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.FontStyle = _
Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.FontStyle
Next
'Size:
For i = 1 To Len(Cells(lngZeile, 1).Text)
.Characters(Start:=i, Length:=1).Font.Size = _
Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Size
Next
For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
.Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Size = _
Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Size
Next
' 'Strikethrough:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.Strikethrough = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Strikethrough
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Strikethrough = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Strikethrough
' Next
' 'Superscript:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.Superscript = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Superscript
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Superscript = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Superscript
' Next
' 'Subscript:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.Subscript = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Subscript
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Subscript = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Subscript
' Next
' 'OutlineFont:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.OutlineFont = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.OutlineFont
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.OutlineFont = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.OutlineFont
' Next
' 'Shadow:
' For i = 1 To Len(Cells(lngZeile, 1).Text)
' .Characters(Start:=i, Length:=1).Font.Shadow = _
' Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Shadow
' Next
' For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
' .Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Shadow = _
' Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Shadow
' Next
'Underline:
For i = 1 To Len(Cells(lngZeile, 1).Text)
.Characters(Start:=i, Length:=1).Font.Underline = _
Cells(lngZeile, 1).Characters(Start:=i, Length:=1).Font.Underline
Next
For i = Len(Cells(lngZeile, 2).Text) To 0 Step -1
.Characters(Start:=Len(Cells(lngZeile, 3).Text) - i, Length:=1).Font.Underline = _
Cells(lngZeile, 2).Characters(Start:=Len(Cells(lngZeile, 2).Text) - i, Length:=1).Font.Underline
Next
End With
NächsteZeile:
Next lngZeile
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Ich freue mich immer über Rückmeldungen.
Grüße, Ulrich

User · 3. Januar 2007

Moin Ulrich,

Hut ab! Ein "brutales Vorgehen", aber bei diesen Anforderungen wohl nicht anders machbar. Der Code wird schneller wenn Du die Bildschirmaktualisierung abschaltest. Ob das allerdings bei Anwendung auf zahlreiche Zellen noch annehmbar bleibt wird nur Hemhol herausfinden.

Code:

Sub übernehmen()
Dim i As Integer
Dim lngZeile As Long
Application.ScreenUpdating = False
For lngZeile = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'Schleife über alle Zeilen
.....
Code gekürzt
.....
Next
End With
Application.ScreenUpdating = True
NächsteZeile:
Next lngZeile
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

losgehts · 3. Januar 2007

Hallo Woody!
Ja, das ist wirklich nicht gerade das gelbe vom Ei, aber ich weiß nun mal nicht so genau, was Helmhol eigentlich genau will.
Dank Dir für den Hinweis mit der Bildschirmaktualisierung! Die einfachsten Sachen vergisst man immer so leicht.
Grüße, Ulrich

Hemhol · 3. Januar 2007

Hallo ihr beiden,

@woody: das mit der Bildschirmaktualisierung probier ich einmal

@Ulrich: vielen Dank, läuft perfekt. Genau so wollte ich das.
Modifizier das jetzt noch ein wenig für meine Bedürfnisse:
- die überflüssigen Formatierungen fliegen raus,
- meine bereits definierten Variablen werden eingefügt
- zur Beschleunigung ändere ich es noch so ab, dass nur vorher gefilterte Zeilen verkettet werden.

Gruß

Hemhol
P.S.: Fahre halt mehrgleisig, so wie du*biggrin.gif*

User · 1. Oktober 2008

Hallo zusammen,

wie muss man den Code ändern um dieses Vorgehen auf 3 Spalten anwenden zu können?
d.h. habe 3 Spalten und will in die vierte den inhalt der vorherigen drei einfügen. (habe ich mit modifikation hinbekommen, aber die formatierung versaut er mir leider)

Danke im Vorraus

Mfg Toni

User · 1. Oktober 2008

zu früh geschossen,

hab es rausgebracht!
danke nocheinmal für dein super Code Ulrich

mfg Toni

Office: Zellen verketten und Formatierung beibehalten

Zellen verketten und Formatierung beibehalten

Zellen verketten und Formatierung beibehalten

Zellen verketten und Formatierung beibehalten

Zellen verketten und Formatierung beibehalten

Zellen verketten und Formatierung beibehalten - Similar Threads - Zellen verketten Formatierung

Zellen verketten und leere Spalten auslassen

Verkettung von Zellen - Schleife

Excel Zellen vergleichen & Formeln verknüpfen

Prüfen und Verketten von Zellen mit Formeln als Inhalt

Verketten,Text,Indirekt und Formatierung in einer Zelle

Inhalte in einer einzigen Zelle verbinden, wenn die Kunden-Nr. identisch ist

Mit Hilfe von VBA verschiedene Zellen immer neu verketten