Sub nachtraeglich()
' erstellt von Hajo.Ziplies@web.de 14.12.02
' SCHRIFT
' für Hintergrund RaZelle.Interior.ColorIndex
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B3:C20,D1:D7")
' ActiveSheet.Unprotect
For Each RaZelle In Selection
' überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
' Kreuz entfernen
RaZelle.Borders(xlDiagonalDown).LineStyle = xlNone
RaZelle.Borders(xlDiagonalUp).LineStyle = xlNone
Select Case RaZelle.Value
Case "1"
' mal eine andere Variante mit Kreuz und Farbe
RaZelle.Borders(xlDiagonalDown).LineStyle = xlContinuous
RaZelle.Borders(xlDiagonalDown).Weight = xlThick
RaZelle.Borders(xlDiagonalUp).LineStyle = xlContinuous
RaZelle.Borders(xlDiagonalUp).Weight = xlThick
RaZelle.Font.ColorIndex = 26
Case "2"
RaZelle.Font.ColorIndex = 24
Case "3"
RaZelle.Font.ColorIndex = 3
' usw.
Case Else
RaZelle.Font.ColorIndex = 0
End Select
End If
Next RaZelle
' ActiveSheet.Protect
Set RaBereich = Nothing
End Sub
aber in meinen zellen steht z.B. mal "test2" mal "test198" oder "test176" wenn ich nun z.B. Case "test" RaZelle.Font.ColorIndex = 3 schreibe färben sich die zellen nicht weil ja nicht nur das wort "test" drinsteht sondern auch noch zahlen ich möchte aber alle zellen wo das wort vorkommt einfärben, geht das ?