dau12345
Nov 14, 2016
view8130
view11
0
Goto Top

VBA Text mit Format übertragen und Zeichen ergänzen

GermansolvedQuestionVB for ApplicationsDevelopment
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!!!
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 320972

Url: https://administrator.de/contentid/320972

Printed on: April 24, 2024 at 07:04 o'clock

11 Comments
Latest comment
Goto Top
Member: colinardo
Solution colinardo Nov 14, 2016, updated at Nov 15, 2016 at 10:50:21 (UTC)
Goto Top
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

back-to-topVorher:
screenshot

back-to-topNachher:
screenshot

Grüße Uwe
Member: Dau12345
Dau12345 Nov 15, 2016 at 08:51:37 (UTC)
Goto Top
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
Member: colinardo
Solution colinardo Nov 15, 2016 updated at 09:37:10 (UTC)
Goto Top
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 face-smile
Member: Dau12345
Dau12345 Nov 15, 2016 at 09:50:38 (UTC)
Goto Top
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 face-sad
Member: Dau12345
Dau12345 Nov 15, 2016 at 09:53:56 (UTC)
Goto Top
Ach muss ich jetzt bei:
Cell_Old.Value = Cell_Old.Value & "," & Cell_Add.Value
"value" weglassen????
Member: Dau12345
Dau12345 Nov 15, 2016 at 10:06:56 (UTC)
Goto Top
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 face-sad
Member: colinardo
Solution colinardo Nov 15, 2016 updated at 10:56:15 (UTC)
Goto Top
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 face-wink.

Wenns das dann war, den Beitrag bitte noch auf gelöst setzen, und Lösungen markieren. Merci.
Member: Dau12345
Dau12345 Nov 15, 2016 at 12:58:59 (UTC)
Goto Top
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
Member: colinardo
Solution colinardo Nov 15, 2016 updated at 15:15:53 (UTC)
Goto Top
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
heart1
Member: Dau12345
Dau12345 Nov 16, 2016 at 08:16:20 (UTC)
Goto Top
Danke Uwe!!!
Du hast mir sehr geholfen!!!

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

?????

Nochmals vielen, vielen Dank!!!!


Lina
Member: colinardo
colinardo Nov 16, 2016 at 08:25:45 (UTC)
Goto Top
Zitat von @Dau12345:
Ich hab noch eine Verständnisfrage.
Was passiert bei : NumberFormat = "@"
Das Zellformat wird auf 'Text' festgelegt.

Nochmals vielen, vielen Dank!!!!
Keine Ursache face-smile

Grüße Uwe
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 CommentsjstrickerWireguard VPN on UDM Pro behind Fritzbox - Handshake did not completejstricker - 3 CommentsAlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments