|
Hallo
so?
Sub Färben()
Dim Wort$, Pos%, Anz%, i%, St%, Farbe(), Arr(), j%
Dim n As Integer
Arr = Array("h", "s", "d", "c")
Farbe = Array(3, 1, 5, 10)
For n = 2 To 112
Wort = ThisWorkbook.Worksheets("SB").Cells(n, 1) 'Beispiel steht in A2
If Wort = "" Then GoTo Weiter
For j = LBound(Arr) To UBound(Arr)
St = 1 'Startwert
Anz = Len(Wort) - Len(Replace(Wort, Arr(j), "")) 'Wie oft ist Buchstabe enthalten
For i = 1 To Anz
Pos = InStr(Mid(Wort, St), Arr(j))
If Pos > 1 Then
With ThisWorkbook.Worksheets("SB").Cells(n, 1).Characters(Start:=St + Pos - 2, Length:=2).Font
.Name = "Arial"
.Size = 14
.ColorIndex = Farbe(j) '3=rot; 1=schwarz; 5=blau; 10=grün
End With
End If
St = Pos + 1
Next i
Next j
Weiter:
Next n
MsgBox "Fertig"
End Sub
LG UweD
|