Yazı Rengine Göre Hücre Say - Microsoft Excel

Fonksiyona alan parametresi gireceğiz, saydırmak istediğimiz renk indeksimizi gireceğiz ve buna göre o renkte kaç adet hücre varsa toplamını bize verecek. Koda göz atalım.

Option Explicit

Public Function YaziRengineGoreHucreSay(alan As Range, renkIndeks As Double) As Double
    Dim sayac As Double
    Dim rnk As Range
    sayac = 0
    
    For Each rnk In alan
        If rnk.Font.ColorIndex = renkIndeks Then
            sayac = sayac + 1
        End If
    Next
    
    YaziRengineGoreHucreSay = sayac
End Function

Option Explicit

'--------------------------------------------------
'İki parametre alan ve sonuç olarak da double değer döndüren
'bir fonksiyon tanımladık.
'
'Birinci parametremiz alan parametresi, saydırma yapacağımız
'alanı belirtmek için bu parametreyi kullanacağız.
'
'İkinci parametre de renk indeksi parametresi.
'Yani koşul parametremiz hacıtora.
'--------------------------------------------------
Public Function YaziRengineGoreHucreSay(alan As Range, renkIndeks As Double) As Double

    '--------------------------------------------------
    'Saydırma işlemi için bir değişken tanımladık.
    '--------------------------------------------------
    Dim sayac As Double
    
    '--------------------------------------------------
    'For Each döngüsü için bir hücrelik alanları
    'belirtmesi amacıyla kullanacağımız bir alan
    'değişkeni tanımladık.
    '--------------------------------------------------
    Dim hcr As Range
    
    '--------------------------------------------------
    'Sayacı sıfırdan başlatıyoruz.
    '--------------------------------------------------
    sayac = 0
    
    '--------------------------------------------------
    'Verilen alanda her hücreyi tek tek kontrol et.
    '--------------------------------------------------
    For Each hcr In alan
    
        '--------------------------------------------------
        'Eğer hücredeki yazının renk indeksi
        'fonksiyonda ikinci parametre olarak
        'verilen indeks değerine eşitse işlem yap.
        '--------------------------------------------------
        If hcr.Font.ColorIndex = renkIndeks Then
        
            '--------------------------------------------------
            'Eğer şart gerçekleşiyorsa bu ilgili
            'hücredeki yazı renginin bizim istediğimiz
            'renge sahip olduğu anlamına geliyor.
            'O halde sayacımızı artıralım.
            '--------------------------------------------------
            sayac = sayac + 1
        End If
    Next
    
    '--------------------------------------------------
    'Sonuç olarak fonksiyon bize bunu göstersin.
    '--------------------------------------------------
    YaziRengineGoreHucreSay = sayac
End Function