Excel: Einzelnes Zeichen eines Zellinhalts in anderer Schriftart

Es kann keine Prozedur ausgeführt werden, solange Sie sich im Bearbeitungsmodus einer Zelle befinden, was der Fall ist, wenn Sie ein einzelnes Zeichen innerhalb einer Zeichenkette markieren und manuell editieren. Um also die Position des umzuwandelnden Zeichens zu ermitteln, muss erst die gesamte Zeichenkette "auseinandergenommen" werden. Im folgenden Lösungsvorschlag wurde dies mit Hilfe eines "Temporären Tabellenblattes" realisiert. Die Zeichenkette wird in dieses Blatt kopiert um die Position des zu konvertierenden Zeichens zu ermitteln. Damit das umzuwandelnde Zeichen erkannt werden kann, wurde ein spezielles Zeichen vorangestellt (das $-Zeichen). Wenn Sie also das Makro in eine bestehende Tabelle einfügen möchten, müsste vor dessen Ausführung jedes Zeichen, das in der Schriftart Symbol dargestellt werden soll, mit dieser Kennzeichnung versehen werden. Dies sollte jedoch kein Problem sein, Sie können das mit BEARBEITEN/ERSETZEN erledigen.

Im Zellinhalt des folgenden Screenshots sollen die beiden mit $ gekennzeichnteten Buchstaben (W+F) in die Schriftart Symbol umgewandelt werden:

Das sieht dann nach der Ausführung des Makros folgendermassen aus:

Im Weiteren gilt es zu beachten:

1. Pro ZELLE können nur max. 2 Zeichen konvertiert werden. Wenn Sie das Makro ein weiteres Mal ausführen, wird ein vorher konvertiertes Zeichen wieder auf "normal" zurückgestellt.

2. Das Makro führt die Umwandlung nur auf der AKTIVEN ZELLE aus. Sie können nur eine ZELLE aktivieren.

3. Vor jedem (x-beliebigen) Zeichen dass umgewandelt werden soll muss sich die Kennzeichnung $ befinden.

Das Zeichen für die Kennzeichnung können Sie selbstverständlich ändern. Ersetzen Sie es dann einfach im Makro.

Führen Sie das Makro am Anfang am Besten einmal schrittweise aus um sich anzusehen, wie es sich genau verhält.

----------------------------------------

MAKRO ZUM KOPIEREN:

----------------------------------------

Sub SchriftartEinzelZeichen()

Dim TXT, TXT1, TXT2, TEMP As String

Dim POS1, POS2 As Variant

If IsEmpty(ActiveCell.Value2) Then

MsgBox "Kein Text in dieser Zelle"

Exit Sub

End If

TXT = ActiveCell.Value2

Selection.Copy

Sheets.ADD

TEMP = ActiveSheet.Name

Range("A1").Select

ActiveSheet.Paste

Range("B1").Select

Application.CutCopyMode = False

On Error GoTo LEER

ActiveCell.Formula = "=FIND(""$"",A1)"

POS1 = ActiveCell.Value

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = _

"=IF(ISERROR(FIND(""$"",RC[-2],(RC[-1]+1))),0,FIND(""$"",RC[-2],(RC[-1]+1)))"

POS2 = ActiveCell.Value

Application.DisplayAlerts = False

Sheets(TEMP).Delete

Application.DisplayAlerts = True

TXT1 = Application.WorksheetFunction.Replace _

(Arg1:=TXT, Arg2:=POS1, _

Arg3:=1, Arg4:="")

ActiveCell.Value = TXT1

If POS2 > 0 Then

POS2 = POS2 - 1

TXT2 = Application.WorksheetFunction.Replace _

(Arg1:=TXT1, Arg2:=POS2, _

Arg3:=1, Arg4:="")

ActiveCell.Value = TXT2

End If

----------------------------------------