Clever-Excel-Forum

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

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.

(16.10.2015, 15:20)atilla schrieb: [ -> ]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

G0408

atilla

G0408