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)
If
Wort =
""
Then
GoTo
Weiter
For
j = LBound(Arr)
To
UBound(Arr)
St = 1
Anz = Len(Wort) - Len(Replace(Wort, Arr(j),
""
))
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)
End
With
End
If
St = Pos + 1
Next
i
Next
j
Weiter:
Next
n
MsgBox
"Fertig"
End
Sub