Thema: Textteile unterschiedlich formatieren | Herbers Excel-Forum

Hallo allerseits,
Ich ab folgendes Problem, vielleicht kann mir jemand weiterhelfen oder Tipps geben.
Aus einem langen String (strMsg) les ich unterschiedliche Textteile aus (strVar). Diese Teile sollen in einer Zelle ausgeschrieben werden, aber mit unterschiedlicher Formatierung. Wenn der Teilstring mit "&" beginnt, soll Fett formatiert werden, saonst Normal. Ich hab das mal folgendermassen im VBA umgesetzt:
If Mid(strMsg, intStartPos, 1) = "&" Then
strVar = Mid(strMsg, intStartPos + 1, intEndPos - intStartPos)
Worksheets("msg").Cells(i, 1) = Worksheets("msg").Cells(i, 1) & " " & strVar
Worksheets("msg").Cells(i, 1).Characters(Len(Worksheets("msg").Cells(i, 1).Value) - Len(strVar), _
Len(strVar)).Font.FontStyle = "Bold Italic"
Else
strVar = Mid(strMsg, intStartPos, intEndPos - intStartPos)
Worksheets("msg").Cells(i, 1) = Worksheets("msg").Cells(i, 1) & " " & strVar
Worksheets("msg").Cells(i, 1).Characters(Len(Worksheets("msg").Cells(i, 1).Value) - Len(strVar), _
Len(strVar)).Font.FontStyle = "Normal"
End If
Das Problem ist, dass wenn ich den neuen Textteil (strVar) mit der Zelle mit bereits bestehendem Text verbinde, die bereits bestehende Formatierung verloren geht.
Könnt ihr mir weiter helfen und sagen, wie man Textteile zu einem Zelleninhalt hinzufügt, ohne dessen Formatierung zu beeinflussen?
Im voraus vielen Dank
felix

Hallo,
Du musst die Formatierung in der zusammengeführten Zelle vornehmen.
So wie in diesem Beitrag.
https://www.herber.de/forum/archiv/1124to1128/t1124450.htm
Gruß Tino

Vielen Dank für die rasche Antwort Tino.
Ich füge ja dem bestehenden Text einen Teil an und formatier diesen anschliessend. Besteht der Text nur aus zwei Teil funktioniert das auch. Bei mehreren wird dann der Text wie der erste Buchstabe in der Zelle formatiert. Ja und natürlich sollte ich viele Texteile zusammenfügen.

Hallo,
lade mal ein Beispiel hoch und beschreibe kurz anhand
welcher kriterien der Text wie Formatiert werden soll.
Gruß Tino

hmmm, gerade als ich die Datei hochladen wollte hab ich den Fuss vom Schlauch gehoben.
Problem ist gelöst: Ich muss den Text gar nicht zerstückeln, sondern kann ja in einer Schlaufe nacheinander nach den Trennzeichen suchen und dann jeweils von dort bis zum Ende des Textes die Formatierung vornehmen.
Vielen Dank. Manchmal braucht man nur jemanden der einem zuhört :-) Es ist unglaublich, aber ich hab sicher ne Stunde daran rumgehirnt.
Gruss
felix

Es funktioniert doch nicht so ganz perfekt :-(
Der Text müsste nach Trennzeichen "," getrennt werden. Wenn der Textteil mit "&" beginnt, soll er ander formatiert werden, wie wenn er mit einem anderen Zeichen beginnt.
Im Beispiel ist zwar alles richtig formatiert, jedoch bleiben die "," und "&" im Text. Ist im Prinzip nicht so schlimm, aber hat jemand eine Ahnung wie man diesen Schöheitsfeheler beheben kann=?
danke
felix
Beispieldatei:
https://www.herber.de/bbs/user/66662.xls

Hallo,
teste mal ob es so gehen könnte.

Sub MsgConcatenator()
Dim strMsg$
Dim rng As Range
Dim objMatch As Object, Regex As Object
Dim iColor As Integer
Dim i&
iColor = 5 'Farbe 

Set Regex = CreateObject("Vbscript.Regexp")
    With Regex
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = "&\w{0,},"
        .Global = True
    End With

For Each rng In Selection

 If rng <> "" And InStr(rng, "&") > 0 Then
        strMsg = rng.Value
        '"<space>" durch Leerzeichen ersetzen 
        strMsg = Replace(strMsg, "<space>", " ")
        '"<openparen>" durch ( ersetzen 
        strMsg = Replace(strMsg, "<openparen>", "(")
        '"<closeparen>" durch ( ersetzen 
        strMsg = Replace(strMsg, "<closeparen>", ")")
        '"<solidus>" durch backslash ersetzen 
        strMsg = Replace(strMsg, "<solidus>", "\")
        '"<u00e4>" durch ä ersetzen 
        strMsg = Replace(strMsg, "<u00e4>", "ä")
        '"<u00e6>" durch ö ersetzen 
        strMsg = Replace(strMsg, "<u00e4>", "ö")
        
        rng.Value = strMsg
    
        With rng.Font
         .ColorIndex = xlAutomatic
         .Bold = False
         .FontStyle = "Arial"
         .Italic = False
        End With
    
        Set objMatch = Regex.Execute(strMsg)
        If Not objMatch Is Nothing Then
         rng = Replace(rng, "&", "")
         rng = Replace(rng, ",", "")
         i = 0
          For Each objMatch In objMatch
            With rng.Characters(objMatch.FirstIndex + 1 - i, Len(objMatch) - 1).Font
             .ColorIndex = iColor       'Farbe 
             .Bold = True               'Fett 
            End With
            i = i + 3
          Next objMatch
            Set objMatch = Nothing
        End If


  End If
Next
End Sub

Gruß Tino

Daaaanke, das ist ja praktisch perfekt. Musste nur einen kleine Änerung vornehmen. Die Länge des einzufärbenden Teils muss um -2 verkürzt werden. Für meine Zwecke ist das eine vollkommen zufriednestellende Lösung. Vielen Dank.
Einen winzigen Schönheitsfehler hats aber doch noch (stört mich absolut nicht). Soll der letzte Teil fomratiert werden, bleibt das letzte Zeichen unformatiert.
Nun zu meinen offenen Fragen:
- was bedeutet das kryptische Suchmuster: .Pattern "&\w{0.},"? Vor allem aus \w{0} kann ich mir keinen Reim machen. "& ... ," steht wahrscheinlich für zu suchende Textstelle.
- wieso wird beim Formatieren der Textstellen i+3 gerechnet? Was steht in den anderen zwei listings?
Vielen Dank für deine kompetente und rasche Lösung
felix

Hallo,
\w ist die Interpretationen von einer Zeichenfolge für den Regulären Ausdruck.
Da gibt es noch mehr.
\d...steht für eine Ziffer: 0-9
\D...kann alles außer einer Ziffer sein
\w...alphanummerische Zeichen. a-Z und 0-9
\W...kein alphanummerisches Zeichen
\s...nicht sichtbare Zeichen wie zB: carrigage return, space usw..
\S...sichtbare Zeichen: alles außer \n, \t, \f und \r
\n...steht für Zeilenumbruch
\t...steht für einen Tabulator
man hätte auch \S verwenden können.
Also ich suche nach einer Zeichenfolge "&alphanummerische Zeichen{0,bisunendlich},".
\w{0.} steht für Anzahl vorkommen alphanummerischer Zeichen (0 bis unendlich)
\w{0,10} wäre 0 bis 10 alphanummerischer Zeichen.
Eine kleine Korrektur müsste noch mit rein, sollte dass erste Zeichen kein & sein.

          For Each objMatch In objMatch
If i = 0 And objMatch.FirstIndex > 1 Then i = 1 'sollte & nicht erstes Zeichen sein
With rng.Characters(objMatch.FirstIndex + 1 - i, Len(objMatch) - 1).Font
.ColorIndex = iColor       'Farbe
.Bold = True               'Fett
End With
i = i + 3
Next objMatch

Gruß Tino

Hallo,
i + 3 ist weil ich die Zeichen & und , raus lösche, muss, sonst passt die Position nicht mehr.
Nachträglich raus löschen funktioniert nicht weil dadurch der gesamte Text wieder nach
dem ersten Zeichen formatiert wird.
Gruß Tino

Hallo,
kannst ja mal testen.
https://www.herber.de/bbs/user/66676.xls
Gruß Tino

Tausend Dank für deine Bemühungen und die detailierten Ausführungen. Du hast Flutlicht ins Dunkel gebracht. Jetzt kann auch ich alles nachvollziehen.
Das Makro passt auch mir ganz gut, sogar sehr gut, eigentlich wie angegossen.
Frohe Festtage
felix

Hallo,
wünsche Dir auch noch frohe Festtage.
Gruß Tino