AW: Zellen abfragen
20.12.2006 07:44:21
haw
Hallo Gerhard und Thorsten,
ich habe den Code von Thorsten auf die Pfeilsymbole geändert (Schriftart Wingdings)
Dieser Code gehört in das Klassenmodul der entsprechenden Tabelle:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 8 And Not Target.Column = 9 Then Exit Sub
Columns("R:R").Font.Name = "Wingdings"
If Target.Column = 8 Then
If Target.Value = "" And Target.Offset(0, 1).Value = "" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 3
.FormulaR1C1 = "é"
End With
End If
If LCase(Target.Value) = "erledigt" And LCase(Target.Offset(0, 1).Value) = "erledigt" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 4
.FormulaR1C1 = "é"
End With
End If
If LCase(Target.Value) = "vorhanden" And LCase(Target.Offset(0, 1).Value) = "vorhanden" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 6
.FormulaR1C1 = "ç"
End With
End If
If Target.Value = "" And LCase(Target.Offset(0, 1).Value) <> "" Then
Range("R" & Target.Row).ClearContents
End If
If Target.Value <> "" And LCase(Target.Offset(0, 1).Value) = "" Then
Range("R" & Target.Row).ClearContents
End If
Else
If Target.Value = "" And Target.Offset(0, -1).Value = "" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 3
.FormulaR1C1 = "é"
End With
End If
If LCase(Target.Value) = "erledigt" And LCase(Target.Offset(0, -1).Value) = "erledigt" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 4
.FormulaR1C1 = "é"
End With
End If
If LCase(Target.Value) = "vorhanden" And LCase(Target.Offset(0, -1).Value) = "vorhanden" Then
With Range("R" & Target.Row)
.Font.ColorIndex = 6
.FormulaR1C1 = "ç"
End With
End If
If Target.Value = "" And LCase(Target.Offset(0, -1).Value) <> "" Then
Range("R" & Target.Row).ClearContents
End If
If Target.Value <> "" And LCase(Target.Offset(0, -1).Value) = "" Then
Range("R" & Target.Row).ClearContents
End If
End If
End Sub
Gruß Heinz