CASE mit 2 Bereichen

Sub Worksheet_Change(ByVal Target As Range) Dim Kal_Bereich As Range, Kal_Cell As Range Set Kal_Bereich = Range("C3:AI154") 'Bereich in dem was geändert wird Set Kal_Bereich = Intersect(Kal_Bereich, Range(Target.Address)) If Kal_Bereich Is Nothing Then Exit Sub For Each Kal_Cell In Kal_Bereich With Range(Kal_Cell.Address, Kal_Cell.Offset(0, 0).Address) Select Case UCase(Kal_Cell.Value) ' UMWANDLUNG DER Eingabe in Großbuchstaben für _ Formatierung Case "B= BEZAHLT FREI" .Interior.ColorIndex = 7 'rosa .Font.ColorIndex = 2 'weiß Case Else .Interior.ColorIndex = 2 .Font.ColorIndex = 0 End Select End With Next Kal_Cell End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Heinz,
so sollte die Formatierung die Formatierung in allen Blättern funktionieren, wenn du das Makro unter dem Blatt Jenner/Januar einfügst.
In den anderen Blättern solllte deine vorhandene Variante reichen.
Gruß
Franz

Sub Worksheet_Change(ByVal Target As Range)
Dim Name_Bereich, Kal_Bereich As Range, Zelle As Range
Dim wks As Worksheet, FarbeZ As Long, FarbeF As Long, Zeile As Long
Set Kal_Bereich = Range("C3:AI154")  'Bereich in dem was geändert wird
Set Name_Bereich = Range("A3:B154")  'Bereich mit Name und Schicht
Set Kal_Bereich = Intersect(Kal_Bereich, Target)
Set Name_Bereich = Intersect(Name_Bereich, Target)
If Not Kal_Bereich Is Nothing Then
For Each Zelle In Kal_Bereich
'Farben entsprechend Wert in Zelle setzen
Select Case UCase(Zelle.Value) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case "B= BEZAHLT FREI"
FarbeZ = 7: FarbeF = 2 'rosa - weiß
Case Else
FarbeZ = 2: FarbeF = 0
End Select
With Zelle
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
Next Zelle
ElseIf Not Name_Bereich Is Nothing Then
For Each Zelle In Name_Bereich
Zeile = Zelle.Row
'Farben entsprechend Wert in Spalte B setzen
Select Case UCase(Cells(Zeile, 2)) ' UMWANDLUNG DER Eingabe in _
Großbuchstaben für Formatierung
Case "S1"
FarbeZ = 7: FarbeF = 2 'rosa - weiß
Case "S2"
FarbeZ = 3: FarbeF = 0 'rot - schwarz
Case "F"
FarbeZ = 6: FarbeF = 0 'gelb - schwarz
Case "S"
FarbeZ = 4: FarbeF = 0 'hellgrün - schwarz
Case "N"
FarbeZ = 8: FarbeF = 0 'hellblau - schwarz
Case Else
FarbeZ = xlColorIndexNone: FarbeF = xlColorIndexAutomatic
End Select
'Zellen in Spalte A und B in allen Monatsblättern formatieren
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "Tabelle4", "Neue Zeiten"
'Tabellen ohne Monatsnamen nicht ändern
Case Else
With wks
'Spalten A und B der Zeile formatieren
With .Range(.Cells(Zeile, 1), .Cells(Zeile, 2))
.Interior.ColorIndex = FarbeZ
.Font.ColorIndex = FarbeF
End With
End With
End Select
Next
Next
End If
End Sub

For Each wks In ActiveWorkbook.Worksheets Select Case wks.Name Case "Jenner", "Februar", "März", "April", "Mai", "Juni", "Juli", "August", _ "September", "Oktober", "November", "Dezember" With wks 'Spalten A und B der Zeile formatieren With .Range(.Cells(Zeile, 1), .Cells(Zeile, 2)) .Interior.ColorIndex = FarbeZ .Font.ColorIndex = FarbeF End With End With Case Else 'In Tabellen mit anderen Namen nichts ändern End Select Next

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread