Dim Auswertung As Variant
Private Sub Farben()
Dim merker_row, merker_col As Integer
Dim Tage As Integer
Dim Monate As Integer
Dim aktuelleZelle As Range
Dim Farbwert As Integer
merker_row = ActiveCell.Row
merker_col = ActiveCell.Column
Application.ScreenUpdating = False
For Each aktuelleZelle In Worksheets("Kalender").Range("AY3:AY7")
aktuelleZelle.Value = ""
Next aktuelleZelle
Application.ScreenUpdating = True
Application.ScreenUpdating = False
For Tage = 3 To 33
Auswertung = Array(0, 0, 0, 0, 0, 0)
For Monate = 4 To 48 Step 4
Farbwert = Worksheets("Kalender").Cells(Tage, Monate).Interior.ColorIndex
Summiere_Farbe Farbwert
Next Monate
For Monate = 51 To 51
Worksheets("Kalender").Cells(Tage, Monate).Value = Auswertung(Tage - 2)
Next Monate
Next Tage
Application.ScreenUpdating = True
Cells(merker_row, merker_col).Activate
End Sub
Public Function Summiere_Farbe(Farbwert As Integer)
Select Case Farbwert
Case 8
Auswertung(1) = Auswertung(1) + 1
Case 4
Auswertung(2) = Auswertung(2) + 1
Case 48
Auswertung(3) = Auswertung(3) + 1
Case 6
Auswertung(4) = Auswertung(4) + 1
Case 22
Auswertung(5) = Auswertung(5) + 1
Case Else
End Select
End Function