Yazı rengine göre sayım

[mozdem]

Merhaba,
Kaç hücrede metin varsa dolu hücreyi saysın. Bu kısma kadar yapıyorum. Ancak bazı hücrelerdeki metin renkleri kırmızı. Evet kırmızı renkli metin hücrlerini ayrı saydırabilirmiyiz.
Bununla ilgili dosya ekte verdim.
Şimdiden teşekkür ederim.

 

[mozdem]

nerede hata yapıyorum

Function renksay(Aralık As Range, _
Renkİndeksi As Integer, _
Optional OfText As Boolean = False) As Long
'Bu fonksiyon belirtilen aralıktaki zemin renginin kaç tane olduğunu verir
'
'
Dim rng As Range
Application.Volatile True

For Each rng In Aralık.Cells
If OfText = True Then
renksay = renksay - _
(rng.Font.ColorIndex = Renkİndeksi)
Else
renksay = renksay - _
(rng.Interior.ColorIndex = Renkİndeksi)
End If
Next rng

End Function

--------------
Forumda arama yaptırdım ve Ali hoca çok güzel bu konuda dosya hazırlamış. inceledim. Ancak yukarıdaki kodu kendime aldım, ama olmadı nerede hata var anlamadım.

 

[mozdem]

inceledim ve çözdüm

Function renklidolusay(Adres As Range, Renkno, islem As Integer)
Dim c As Range
On Error Resume Next
Toplam = 0
If islem = 1 Then
For Each c In Adres
If c.Font.ColorIndex = Renkno And c <> "" Then Toplam = Toplam + 1 'dolu olan hücre sayısı

Next
End If

renklidolusay = Toplam
End Function

-------------
Ali hocanın paylaşmış olduğu dosyadan yararlanarak çözdüm Ali hocaya teşekkürlerimi iletirim

 

[Necdet]

Merhaba,

Bir ara uğraşmıştım, belki işinize yarayabilir : Renkli Hücreleri Sayma ve Toplama