Die Datei https://www.herber.de/bbs/user/9993.xls wurde aus Datenschutzgründen gelöscht
Gruß
Sub Farbformate_zählen()
Dim Zelle As Range
[B38] = ""
[D38] = ""
[E38] = ""
[F38] = ""
For Each Zelle In Range(Cells(3, 1), Cells(33, 10))
If Zelle.Interior.ColorIndex = 35 Then [B38] = [B38] + 1 ' grün
If Zelle.Interior.ColorIndex = 40 Then [D38] = [D38] + 1 ' rosa
If Zelle.Interior.ColorIndex = 38 Then [E38] = [E38] + 1 ' pink
If Zelle <> "" And WorksheetFunction.Weekday(Zelle.Value, 2) > 5 Then [F38] = [F38] + 1 ' oliv
Next Zelle
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row <> 38 Then Exit Sub
If Target.Column > 1 And Target.Column < 6 Then
For Each x In Range("aa")
On Error Resume Next
If x.Interior.ColorIndex = Target.Offset(-1, 0).Interior.ColorIndex Then
If WorksheetFunction.Weekday(x.Value, 2) < 6 Then
z = z + 1
End If
End If
Next
Target.Value = z
End If
Cancel = True
z = 0
End Sub