Gruppe
Ereignis
Problem
Bei Zahleneingaben in Spalte A sollen die Hintergrundfarbenfestlegung gem. Tabelle Colors erfolgen.
ClassModule: Tabelle1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vRow As Variant
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then
If WorksheetFunction.CountA(Target) = 0 Then
Target.Interior.ColorIndex = xlColorIndexNone
Exit Sub
Else
Exit Sub
End If
End If
With Worksheets("Colors")
If IsEmpty(Target) Then
Target.Interior.ColorIndex = xlColorIndexNone
Else
vRow = Application.Match(Target.Value, .Columns(1), 0)
If Not IsError(vRow) Then
Target.Interior.ColorIndex = .Cells(vRow, 1).Interior.ColorIndex
Else
Target.Interior.ColorIndex = xlColorIndexNone
End If
End If
End With
End Sub