Hallo

Ich hoffe ich konnte auch x helfen ...

Gruß

Werner

Option Explicit
Option Base 1
Private Type f_rec
  FarbIndex As Integer
  Summe As Double
End Type

Sub Schaltfläche272_BeiKlick()

  '*** bildet die Summe über die numerischen Werte aller farbigen Zellen pro Farbe und gibt das Ergebnis auf einem temp. Arbeitsblatt aus.
  '*** (nicht betrachtet werden Zellen, die den Colorindex xlColorIndexNone oder xlColorIndexAutomatic haben)
  Dim f() As f_rec, f_cnt As Integer, f_ind As Integer
  Dim Zelle As Range, Blattname As String, ws As Worksheet
  Dim i_Farbe As Integer, d_Wert As Double, i As Integer
  Dim z As Long
  ReDim f(6)
  
  'den benutzten Bereich des aktiven Blattes selektieren
  ActiveSheet.Range("h8: FS8").Select ' Zellen selektieren"
 
  'den jeweiligen Farbzähler auf 0 setzen
  f(1).Summe = 0 ' Rot
  f(2).Summe = 0 ' grün
  f(3).Summe = 0 ' gelb
  f(4).Summe = 0 ' schartz
  f(5).Summe = 0 '
  f(6).Summe = 0 '
       
  'alle selektierten Zellen nacheinander bearbeiten
  For Each Zelle In Selection
 
  'abfrage nach Zellenfarbe?
  i_Farbe = Zelle.Interior.ColorIndex
   
  If (i_Farbe = 3) Then f(1).Summe = f(1).Summe + 1
  If (i_Farbe = 4) Then f(2).Summe = f(2).Summe + 1
  If (i_Farbe = 6) Then f(3).Summe = f(3).Summe + 1
  If (i_Farbe = 1) Then f(4).Summe = f(4).Summe + 1
  If Not ((i_Farbe = 2) Or (i_Farbe = 3) Or (i_Farbe = 4)) Or (i_Farbe = 1) Then f(6).Summe = f(6).Summe + 1
   
  Next
  ActiveSheet.Cells(1, 1).Select
  ActiveSheet.Cells(8, 1).Value = f(1).Summe ' Rot
  ActiveSheet.Cells(8, 2).Value = f(2).Summe ' grün
  ActiveSheet.Cells(8, 3).Value = f(3).Summe ' gelb
  ActiveSheet.Cells(8, 4).Value = f(4).Summe ' schartz
  ActiveSheet.Cells(8, 5).Value = f(6).Summe ' rest
  End Sub