Nicht jede zelle einzelt anklicken müssen VBA
26.04.2015 08:14:13
Werner
Guten Morgen,
wie kann man es automatisieren, dass ich nicht jede Zelle einzelt anfassen muss, damit es sich einfärbt?
Sorry ich bin totaler Laie was VBA angeht.grüße Werner
hier der Code
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo errExit
'Für den Bereich A1 bis D20. Ansonsten kann dieser in der Folgezeile angepasst werden.
If Intersect(Target, ActiveSheet.Range("A1:BF375")) Is Nothing Then Exit Sub 'Bitte den Bereich _
_
anpassen
'Web bei Klaus-Dieter'
'http://excelwelt.de/excelallg/farb.html = farben'
Select Case Target.Value
Case "S": Target.Interior.ColorIndex = 23 '<- 23 für die Farbe Himmelblau
Case "Zu": Target.Interior.ColorIndex = 6
Case "ZU": Target.Interior.ColorIndex = 6
Case "SU": Target.Interior.ColorIndex = 6
Case "Su": Target.Interior.ColorIndex = 6
Case "xF": Target.Interior.ColorIndex = 46
Case "XF": Target.Interior.ColorIndex = 46
Case "Xf": Target.Interior.ColorIndex = 46
Case "xf": Target.Interior.ColorIndex = 46
Case "K": Target.Interior.ColorIndex = 3
Case "k": Target.Interior.ColorIndex = 3
Case "Ko": Target.Interior.ColorIndex = 54
Case "ko": Target.Interior.ColorIndex = 54
Case "N": Target.Interior.ColorIndex = 11
Case "n": Target.Interior.ColorIndex = 11
Case "N1", "BR": Target.Interior.ColorIndex = 32
Case "n1", "br": Target.Interior.ColorIndex = 32
Case "F1": Target.Interior.ColorIndex = 37
Case "F2": Target.Interior.ColorIndex = 37
Case "F3": Target.Interior.ColorIndex = 37
Case "F4": Target.Interior.ColorIndex = 37
Case "D": Target.Interior.ColorIndex = 43
Case "S1": Target.Interior.ColorIndex = 38
Case "S2": Target.Interior.ColorIndex = 38
Case "FTN", "eF", "T": Target.Interior.ColorIndex = 26
Case "U", "B", "b": Target.Interior.ColorIndex = 6
Case "u": Target.Interior.ColorIndex = 6
Case "SN": Target.Interior.ColorIndex = 12
Case "SN1": Target.Interior.ColorIndex = 12
Case "f", "F": Target.Interior.ColorIndex = 45
Case "x", "X": Target.Interior.ColorIndex = 4
Case "kw", "KW", "kW", "Kw": Target.Interior.ColorIndex = 28
Case "Mo", "Di", "Mi", "Do", "Fr": Target.Interior.ColorIndex = 19
Case "Sa", "So", "Reformationstag", "Neujahr", "Karfreitag", "Ostermontag", "Maifeiertag", " _
_
Himmelfahrt", "Pfingstmontag", "Deut.Einheit", "1.Weihnachten", "2.Weihnachten": Target. _
Interior.ColorIndex = 15
'Neujahr,Karfreitag,Ostermontag,Maifeiertag,Himmelfahrt,Pfingstmontag,Deut.Einheit,1. _
Weihnachten,2.Weihnachten'
On Error GoTo errExit
If Intersect(Target, ActiveSheet.Range("A1:BF375")) Is Nothing Then Exit Sub
Case Else
Target.Interior.ColorIndex = xlNone
End Select
errExit:
Exit Sub
End Sub