VBA Text mit Format übertragen und Zeichen ergänzen

gelöstFrage VB for Applications Entwicklung

Hallo,

ich habe ein Problem. Ich möchte den Text, der in einer Zelle steht, ergänzen.
Bisher habe ich das immer so gemacht:

Dim AlterZellinhalt as string
Dim Zusatztext as string

AlterZellinhalt = Worksheets(ActiveWorkbook.Sheets.Count).Cells(a + 3, b + 1).Value
Zusatztext = Worksheets("NeueDaten").Cells(c + 2, 2).Value
AlterZellinhalt = Alterzellinhalt & ", " & Zusatztext

Da aber nur die Werte übertragen werden, gehen die Formate des Textes verloren.
Wie kann ich den Text mit den Formaten behalten und trotzdem neue Daten ergänzen?

Danke für Eure Hilfe!!!

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 320972

Url: https://administrator.de/forum/vba-text-mit-format-uebertragen-und-zeichen-ergaenzen-320972.html

Ausgedruckt am: 23.04.2025 um 19:04 Uhr

11 Kommentare

Neuester Kommentar

Servus Dau12345,
das lässt sich machen, hier ein Beispiel:

Sub AddtoCellWithFormatting()
    Dim cell_old As Range, cell_add As Range, cell_merge As Range, i As Long, c As Characters
    ' Zelle welche ergänzt werden soll  
    Set cell_old = Range("A1")  
    'Zelle mit dem Ergänzungswert  
    Set cell_add = Range("B1")  
    'Ergebniszelle  
    Set cell_merge = Range("C1")  
    ' Text zusammenfügen  
    cell_merge.Value = cell_old.Value & "," & cell_add.Value  
    
    'Formatierung übertragen  
    For i = 1 To cell_old.Characters.Count
        With cell_merge.Characters(i, 1)
            Set c = cell_old.Characters(i, 1)
            .Font.Color = c.Font.Color
            .Font.FontStyle = c.Font.FontStyle
            .Font.Size = c.Font.Size
            .Font.Underline = c.Font.Underline
        End With
    Next
    For i = 1 To cell_add.Characters.Count
        With cell_merge.Characters(cell_old.Characters.Count + 1 + i, 1)
            Set c = cell_add.Characters(i, 1)
            .Font.Color = c.Font.Color
            .Font.FontStyle = c.Font.FontStyle
            .Font.Size = c.Font.Size
            .Font.Underline = c.Font.Underline
        End With
    Next
    cell_merge.Copy cell_old
    cell_merge.Clear
End Sub

Vorher:

Nachher:

Grüße Uwe

Hallo Colinardo,

danke für die schnelle Hilfe.
Aber leider enthält nicht nur der Ergänzungstext, sondern auch die alte Zelle Formate.
Zudem kann ich "Range" nicht verwenden, weil ich mehrere veränderliche Spalten und Zeilen absuchen muss. Dazu muss der Bereich durch Variablen angegeben werden: z.B. Cells(a + 3, b + 1).

Hast Du auch dafür noch eine Lösung?

Gruß,
Dau12345

Zitat von @Dau12345:
Aber leider enthält nicht nur der Ergänzungstext, sondern auch die alte Zelle Formate.

Macht nichts, die bleiben ja per Default erhalten.

Zudem kann ich "Range" nicht verwenden, weil ich mehrere veränderliche Spalten und Zeilen absuchen muss. Dazu muss der Bereich durch Variablen angegeben werden: z.B. Cells(a + 3, b + 1).

Das war ja nur ein Beispiel kannst du natürlich so weiterhin verwenden!
Nur das Value am Ende weglassen!

set cell_old = Worksheets(ActiveWorkbook.Sheets.Count).Cells(a + 3, b + 1)

Und das für beide Variablen.

Hast Du auch dafür noch eine Lösung?

Ist schon drin

Hallo Uwe,

das Problem mit dem "Range" hab ich schon gelöst und "Range" wieder durch "Cells" ersetzt.
Aber mein Ursprungstext hat mehrere Formatierungen: ein Wort ist Fett, eins Unterstrichen, ein Wort ist rot.
Jetzt sind alle Worte rot und weder Fett noch Unterstrichen.

Bei der Zeile "For i = 1 To cell_add.Characters.Count "
bekomme ich immer den Fehler: '1004' Die Count-Eigenschaft des Characters-Objektes kann nicht zugeordnet werden.

Ach Menno.
Ich bleibe eben doch ein Dau

Ach muss ich jetzt bei:
Cell_Old.Value = Cell_Old.Value & "," & Cell_Add.Value
"value" weglassen????

Hallo Uwe,

In meinem Ursprungstext hat mehrere Formatierungen: das erste Zeichen ist rot, dann kommen ein paar Zeichen in schwarz und fett ...
Jetzt sind alle Worte rot und weder Fett noch Unterstrichen.

Bei der Zeile "For i = 1 To cell_add.Characters.Count "
bekomme ich immer den Fehler: '1004' Die Count-Eigenschaft des Characters-Objektes kann nicht zugeordnet werden.

Ach Menno.
Ich bleibe eben doch ein Dau 

In meinem Ursprungstext hat mehrere Formatierungen: das erste Zeichen ist rot, dann kommen ein paar Zeichen in schwarz und fett ...
Jetzt sind alle Worte rot und weder Fett noch Unterstrichen.

Ach so das meintest du, ist oben im Code ergänzt

Und falls du es nicht glaubst, hier eine Demo-Datei:
merge_cell_formatting_320972.xlsm

Ich bleibe eben doch ein Dau

Daran kann man arbeiten indem man weniger Google nutzt und sich mehr mit der Doku beschäftigt .

Wenns das dann war, den Beitrag bitte noch auf gelöst setzen, und Lösungen markieren. Merci.

Hallo Uwe,

bei Deinem Text funktioniert Dein Programm super. Leider ist mein Text anders und wenn ich einfach meinen Text in Deine Tabelle einfüge und dann das Makro starte kommt sofort Fehler 400. Er schreibt dann die alles in Zelle c1, lässt aber die Formate von Zelle B1 weg.
Ich vermute es liegt daran, dass mein Text eigentlich kein Text sondern eine als Text formatierte Zahl ist.
in A1 steht z.B. 13, 14, 15, 16, ZS
in B1 steht immer eine Zahl. z.B. 15
oder 16.3 oder ....
Am Ende soll in der Zelle A1 eigentlich 13, 14, 15, 16, ZS - 15
stehen. Aber auch mit dem "-" wird es wohl nichts werden, weil Excel dann immer denkt, es handele sich um eine Formel.
Vielleicht geht aber "_" ???

Kann man das Makro so ändern, dass auch als Text formatierte Zahlen übertragen werden können?

Vielen, vielen Dank für Deine Hilfe!!!!

Gruß,
Lina

Kann man das Makro so ändern, dass auch als Text formatierte Zahlen übertragen werden können?

Kann man.

Sub AddtoCellWithFormatting()
    Dim cell_old As Range, cell_add As Range, cell_merge As Range, i As Long, c As Characters
    On Error Resume Next
    Application.ScreenUpdating = False
    ' Zelle welche ergänzt werden soll  
    Set cell_old = Range("A1")  
    'Zelle mit dem Ergänzungswert  
    Set cell_add = Range("B1")  
    'temporäre Ergebniszelle  
    Set cell_merge = Range("C1")  
    cell_merge.NumberFormat = "@"  
    ' Text zusammenfügen  
    cell_merge.Value = cell_old.Text & "-" & cell_add.Text  
    
    'Formatierung übertragen  
    If Not TypeName(cell_old.Value) = "String" Then  
        With cell_merge.Characters(1, Len(cell_old.Text)).Font
            .Color = cell_old.Font.Color
            .FontStyle = cell_old.Font.FontStyle
            .Size = cell_old.Font.Size
            .Underline = cell_old.Font.Underline
        End With
    Else
        For i = 1 To cell_old.Characters.Count
            With cell_merge.Characters(i, 1)
                Set c = cell_old.Characters(i, 1)
                .Font.Color = c.Font.Color
                .Font.FontStyle = c.Font.FontStyle
                .Font.Size = c.Font.Size
                .Font.Underline = c.Font.Underline
            End With
        Next
    End If
    
    If Not TypeName(cell_add.Value) = "String" Then  
        With cell_merge.Characters(cell_old.Characters.Count + 2, Len(cell_add.Text)).Font
            .Color = cell_add.Font.Color
            .FontStyle = cell_add.Font.FontStyle
            .Size = cell_add.Font.Size
            .Underline = cell_add.Font.Underline
        End With
    Else
        For i = 1 To cell_add.Characters.Count
        With cell_merge.Characters(cell_old.Characters.Count + 1 + i, 1)
                Set c = cell_add.Characters(i, 1)
                .Font.Color = c.Font.Color
                .Font.FontStyle = c.Font.FontStyle
                .Font.Size = c.Font.Size
                .Font.Underline = c.Font.Underline
            End With
        Next
    End If
    
    cell_merge.Copy cell_old
    cell_merge.Clear
    Application.ScreenUpdating = True
End Sub

Danke Uwe!!!
Du hast mir sehr geholfen!!!

Ich hab noch eine Verständnisfrage.
Was passiert bei : NumberFormat = "@"

?????

Nochmals vielen, vielen Dank!!!!

Lina