Farbwechsel in Celle nach Änderung Jahreszahl

[G0408]

für die Erstellung von Trennblättern arbeite ich mit dem nachstehenden Makro, das auch funktioniert.

Sub FarbeJahreszahl()
'
    On Error Resume Next
    ActiveCell.Offset(0, 4).Select
    If ActiveCell.Offset(0, 0).Range("A1") = 2011 Then
    Selection.Interior.ColorIndex = 6
 
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2012 Then
    Selection.Interior.ColorIndex = 33
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2013 Then
    Selection.Interior.ColorIndex = 40
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2014 Then
    Selection.Interior.ColorIndex = 4
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2015 Then
    Selection.Interior.ColorIndex = 3
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2016 Then
    Selection.Interior.ColorIndex = 6
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = 2017 Then
    Selection.Interior.ColorIndex = 33
    
    ElseIf ActiveCell.Offset(0, -0).Range("A1") = "" Then
    Selection.Interior.ColorIndex = 0
    End If
    On Error Resume Next
    ActiveCell.Offset(-1, 0).Select
    End Sub

Die Farbe der Jahreszahl wiederholt sich alle 5 Jahre. Wie ist das Makro zu ändern, dass ich nicht das Makro manuell um die Folgejahre ergänzen muss?

Danke schon im Voraus für eine Hilfe
Gerhard

[atilla]

Hallo Gerhard,

die banalste Lösung wäre hier mit Select Case statt If und Elseif zu arbeiten:

Code:

Sub FarbeJahreszahl_ati()
'
   ActiveCell.Offset(0, 4).Select
   Select Case Range("A1").Value
       Case Is = 2011, 2016, 2021, 2026, 2031
           Selection.Interior.ColorIndex = 6
        Case Is = 2012, 2017, 2022, 2027, 2032
           Selection.Interior.ColorIndex = 33
       Case Is = 2013, 2018, 2023, 2028, 2033
           Selection.Interior.ColorIndex = 40
       Case Is = 2014, 2019, 2024, 2029, 2034
           Selection.Interior.ColorIndex = 4
       Case Is = 2015, 2020, 2025, 2030, 2035
           Selection.Interior.ColorIndex = 3
       Case Is = ""
           Selection.Interior.ColorIndex = 0
   End Select
   
   If ActiveCell.Row > 1 Then
       ActiveCell.Offset(-1, 0).Select
   End If
   
End Sub

Man kann das aber auch mit einer Subtraktion, einer Division und dem Vergleich des Restwerts mathematisch feststellen und verallgemeinern.
Der Code wäre aber für Dich nicht verständlicher oder einfacher oder kürzer.

[G0408]

Hallo Gerhard,

die banalste Lösung wäre hier mit Select Case statt If und Elseif zu arbeiten:

Code:

Sub FarbeJahreszahl_ati()
'
   ActiveCell.Offset(0, 4).Select
   Select Case Range("A1").Value
       Case Is = 2011, 2016, 2021, 2026, 2031
           Selection.Interior.ColorIndex = 6
        Case Is = 2012, 2017, 2022, 2027, 2032
           Selection.Interior.ColorIndex = 33
       Case Is = 2013, 2018, 2023, 2028, 2033
           Selection.Interior.ColorIndex = 40
       Case Is = 2014, 2019, 2024, 2029, 2034
           Selection.Interior.ColorIndex = 4
       Case Is = 2015, 2020, 2025, 2030, 2035
           Selection.Interior.ColorIndex = 3
       Case Is = ""
           Selection.Interior.ColorIndex = 0
   End Select
   
   If ActiveCell.Row > 1 Then
       ActiveCell.Offset(-1, 0).Select
   End If
   
End Sub

Man kann das aber auch mit einer Subtraktion, einer Division und dem Vergleich des Restwerts mathematisch feststellen und verallgemeinern.
Der Code wäre aber für Dich nicht verständlicher oder einfacher oder kürzer.

Hallo Attila,

klapptbei mir leider nicht wie gewünscht. Wenn ich das Makro teste, funktioniert zwar das offset, nicht aber die Farbänderung.

Gruß Gerhard