Renge Göre EĞERSAY

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Merhaba Arkadaşlar,

A1:B4 alanında 2 hücrenin dolgu rengi sarı, 1 hücre kırmızı, 4 hücre siyah renkte. Bu renklere göre hücre adetlerinin sayımını formül ile veya makro ile yapılması mümkün müdür ?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,216
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Yeni sürümleri bilmiyorum ama eski sürümlerde hücre renklerini saydırma yok. Ancak makro ile yapabilirsiniz.
Aşağıdaki fonksiyonu kullanabilirsiniz.

Alanı belirledikten sonra örnek bir hücreyi de belirlemeniz gerekir.

Örneğin A1:B4 aralığı olsun. B3 hücresinin arka plan rengi kırmızı ise ve kırmızı hücrerin sayısını bulmak istiyorsanız :

Kod:
=RenkSay(A1:B4;B3)
ile A1:B4 aralığındaki kırmızı renkli hücrelerin sayısını verir.

Kod:
Function RenkSay(Rng As Range, Ornek As Range)

    Dim Adt As Long, _
        Hcr As Range
  
    For Each Hcr In Rng
        If Hcr.Interior.Color = Ornek.Interior.Color Then Adt = Adt + 1
    Next Hcr
  
    RenkSay = Adt
  
End Function
Kullanıcı Tanımlı Fonksiyonu biraz daha geliştirdim. Seçenek Ekledim. Bu seçenek değerine göre (0) sadece renkli hücreleri sayarsınız, 1 ise hücre değerlerini toplarsınız.

Kullanımı Yukarıda verdiğim örneğe benzer fakat bir parametre daha eklenmiş oldu.

Kod:
=Renksay($A$1:$B$4;B3;1)
Bu kullanımda B3 hücresindeki renkle aynı olanların içeriklerini toplar. Son parametre 0 ya da 1 olmalı. Değer verilmezse 0 kabul eder ve sadece renkli hücreleri sayar.

Kod:
Function RenkSay(Rng As Range, Ornek As Range, Optional Ne As Integer = 0)

    On Error Resume Next
   
    Dim Adt As Long, _
        Tpl As Variant, _
        Hcr As Range
   
    For Each Hcr In Rng
   
        If Hcr.Interior.Color = Ornek.Interior.Color Then
            If Ne = 0 Then
                Adt = Adt + 1
            Else
                Tpl = Tpl + Hcr.Value
            End If
        End If
               
    Next Hcr
   
    If Ne = 0 Then
        RenkSay = Adt
    Else
        RenkSay = Tpl
    End If
   
End Function
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,216
Excel Vers. ve Dili
Ofis 365 Türkçe
Güle güle kullanınız.

Daha Ayrıntılı Çalışma İçin TIKLAYINIZ
 
Üst