Koşullu Biçimlendirme Renk Sayma Makro Kodu

Private Sub Worksheet_Change(ByVal Target As Range) ' sayfada değişiklik olduğunda devreye giren prosedür
Dim sf As Worksheet
Set sf = Sheets("çalışma") ' sayfa ismi

If Intersect(Target, [F3:Q8]) Is Nothing Then Exit Sub ' hangi hücre aralığında değişim olmasıyla kodun devre gireceği
renk1 = sf.Range("D2").DisplayFormat.Interior.Color 'dolgu rengi referans hücre
renk2 = sf.Range("E2").DisplayFormat.Interior.Color 'dolgu rengi referans hücre
say1 = 0: say2 = 0 ' renklerimizin başlangıç sayıları

For i = 3 To 9 'başlıngıç ve bitiş satırları
    For k = 6 To 17 ' başlangıç ve bitiş sütunları
    KBrenk = sf.Cells(i, k).DisplayFormat.Interior.Color
        If renk1 = KBrenk Then 'birinci renk koşulu
        say1 = say1 + 1 'koşul gerçekleştiğinde önceki sayıya +1 eklenmesi
        ElseIf renk2 = sf.Cells(i, k).DisplayFormat.Interior.Color Then 'ikinci renk koşulu
        say2 = say2 + 1 'koşul gerçekleştiğinde önceki sayıya +1 eklenmesi
        End If
    Next k
    sf.Cells(i, "D") = say1  'toplam renk sayısının hücreye yazılması
    sf.Cells(i, "E") = say2  'toplam renk sayısının hücreye yazılması
Next i

End Sub