Renklere ve Değere Göre Sayma

[Allback]

Merhaba,

Ekte basit bir vardiya çizelgesi yaptım.
Bu çizelgede "H.T" yazan yerler çalışanın hafta tatili yapacağını gösteriyor.
Ama bazı durumlarda çalışanı hafta tatilinde mesaiye çağırıyorum. Bu durumlarda hangi vardiyada mesai yapacaksa "H.T" yerine çalışacağı vardiyayı yazıyorum.

Yaptığım bu mesaileri vardiyalara göre saymak istiyorum.
Aslında bir nevi eğersay işlemi yapmak istiyorum ama eğersay işlemindeki gibi ölçüt değerini seçtiğimde, hücre renginin de seçtiğim ölçüte uyanlarını saydırmak istiyorum.
Umarım anlatabilmişimdir.

 

[muygun]

Merhaba;
Hücre rengini işlevlerle sayamazsınız.
ekteki makro çözümü deneyin.
İyi çalışmalar.

 

[Allback]

Merhaba;
Hücre rengini işlevlerle sayamazsınız.
ekteki makro çözümü deneyin.
İyi çalışmalar.

Çok teşekkürler, ellerinize sağlık.
Aslında istediğim sonucu veriyor ama bunu butona atamadan ben hücrede değişiklik yaptığımda sonuçlar direk değişecek şekilde yapabilir miyiz?
Makro olduğu için tetiklenmesi şart mı?

 

[Korhan Ayhan]

Forumda bolca örnek var.

https://www.excel.web.tr/threads/ktf-renkli-huecreleri-toplama-ve-sayma.34042/

 

[Allback]

Forumda bolca örnek var.

https://www.excel.web.tr/threads/ktf-renkli-huecreleri-toplama-ve-sayma.34042/

Korhan Bey,

Konuyu açmadan önce Necdet Bey'in örneğini görüp inceledim.
Hatta tam aradığımı buldum sandım ama içinde numerik değerler olan tüm hücreleri sayıyor.
Ben hücrenin içindeki değerin de aynı olduğu hücreleri saydırmak istiyorum.
Yani hücre rengi sarı olan ve içinde 2 yazan kaç tane hücre var onu saymak istiyorum.
muygun'un hazırladığı örnek ile bunu kısmen yapıyor.
Sadece Necdet Bey'in örneğindeki gibi hücre rengi veya içeriği değiştiğinde sonucun direkt değişmesini sağlayabilirsem tam olacak...

 

[Korhan Ayhan]

Aşağıdaki KTF'yi deneyebilirsiniz.

Kullanım örnekleri;

=R_TOPLA_SAY(B$6:B$14;$A16;YANLIŞ) 'Alandaki rengi ve değeri uyan hücrelerdeki verileri sayar.
=R_TOPLA_SAY(B$6:B$14;$A16;0) 'Alandaki rengi ve değeri uyan hücrelerdeki verileri sayar.
=R_TOPLA_SAY(B$6:B$14;$A16) 'Alandaki rengi ve değeri uyan hücrelerdeki verileri toplar.
=R_TOPLA_SAY(B$6:B$14;$A16;1) 'Alandaki rengi ve değeri uyan hücrelerdeki verileri toplar.
=R_TOPLA_SAY(B$6:B$14;$A16;DOĞRU) 'Alandaki rengi ve değeri uyan hücrelerdeki verileri toplar.

Option Explicit

Function R_TOPLA_SAY(Alan As Range, Kriter As Variant, Optional İşlem As Boolean = True)
    Dim Veri As Range
    
    Application.Volatile True
    
    For Each Veri In Alan
        If Veri.Interior.ColorIndex = Kriter.Interior.ColorIndex Then
            If Veri.Value = Kriter.Value Then
                If İşlem = True Then
                    If IsNumeric(Veri.Value) Then
                        R_TOPLA_SAY = R_TOPLA_SAY + Veri.Value
                    End If
                Else
                    R_TOPLA_SAY = R_TOPLA_SAY + 1
                End If
            End If
        End If
    Next
End Function

 

[Ali]

Aşağıdaki linki de inceleyebilirsiniz.

Renkli zemin ve Font Özelliklerine Göre Uygulamalar

 

[Ali]

hücre rengi veya içeriği değiştiğinde sonucun direkt değişmesini sağlayabilirsem tam olacak...

Sayfadaki renk değişimi makrodaki change olayını tetiklemez , sizin tekrar ilgili kullanıcı tanımlı fonksiyonu çalıştırmanız gerekir.

 

[msofuoglu]

Herkese merhaba,
Taslak organizasyon şemasında; bir - 3 ve altı ay sonra işe kaç kişi başlatılacağını belirleyen organizasyon şemasında kutuları saymak yerine bir numaralı mesaj benzeri gibi ekte örneği yer alan dosyada ilgili renklerin nasıl sayılacağını beceremedim. Buradaki makro ya da diğer çalışmalardan faydalanarak yapmayı başaramadım. Şimdiden teşekkür ediyor herkese sağlıklı, huzurlu günler diliyorum.

 

[Ali]

Birleştirilmiş hücre kullanmışsınız. Kullanıcı tanımlı fonksiyon kullanırsak, bunların herbirini bir hücre sayacak. Eğer hücre birleştirmeden , ilgili hücreyi genişleterek kullanırsanız zemin rengi sayılabilir.

 

[msofuoglu]

Birleştirilmiş hücre kullanmışsınız. Kullanıcı tanımlı fonksiyon kullanırsak, bunların herbirini bir hücre sayacak. Eğer hücre birleştirmeden , ilgili hücreyi genişleterek kullanırsanız zemin rengi sayılabilir.

İlginiz için teşekkür ederim Ali bey, ünvana göre hücrelerde değişiklik olması gerekiyor fakat önerinize göre revize etmeye çalışacağım. Sağlıklı ve huzurlu günler dilerim.

 

[Korhan Ayhan]

Merhaba,

Dosyanıza boş bir modüle ekleyin ve aşağıdaki kodu uygulayın.

Option Explicit

Function R_TOPLA_SAY(Alan As Range, Kriter As Variant, Optional İşlem As Boolean = True)
    Dim Veri As Range, Adres As Object, Merge_Cells As Range
   
    Application.Volatile True
   
    Set Adres = VBA.CreateObject("Scripting.Dictionary")
   
    For Each Veri In Alan
        If Veri.Interior.ColorIndex = Kriter.Interior.ColorIndex Then
            If Not Adres.Exists(Veri.Address) Then
                For Each Merge_Cells In Veri.MergeArea
                    Adres.Add Merge_Cells.Address, Nothing
                Next
                If İşlem = True Then
                    If IsNumeric(Veri.Value) Then
                        R_TOPLA_SAY = R_TOPLA_SAY + Veri.Value
                    End If
                Else
                    R_TOPLA_SAY = R_TOPLA_SAY + 1
                End If
            End If
        End If
    Next
   
    Set Adres = Nothing
End Function

Sonra dosyanızı "Makro İçerebilen Excel Çalışma Kitabı" formatıyla kayıt edin.

Excel sayfasında L19 hücresine aşağıdaki formülü uygulayın.

=R_TOPLA_SAY($D$28:$CM$80;B19;0)

Diğer hücreleri siz halledersiniz...

 

[msofuoglu]

Merhaba,

Dosyanıza boş bir modüle ekleyin ve aşağıdaki kodu uygulayın.

Option Explicit

Function R_TOPLA_SAY(Alan As Range, Kriter As Variant, Optional İşlem As Boolean = True)
    Dim Veri As Range, Adres As Object, Merge_Cells As Range
  
    Application.Volatile True
  
    Set Adres = VBA.CreateObject("Scripting.Dictionary")
  
    For Each Veri In Alan
        If Veri.Interior.ColorIndex = Kriter.Interior.ColorIndex Then
            If Not Adres.Exists(Veri.Address) Then
                For Each Merge_Cells In Veri.MergeArea
                    Adres.Add Merge_Cells.Address, Nothing
                Next
                If İşlem = True Then
                    If IsNumeric(Veri.Value) Then
                        R_TOPLA_SAY = R_TOPLA_SAY + Veri.Value
                    End If
                Else
                    R_TOPLA_SAY = R_TOPLA_SAY + 1
                End If
            End If
        End If
    Next
  
    Set Adres = Nothing
End Function

Sonra dosyanızı "Makro İçerebilen Excel Çalışma Kitabı" formatıyla kayıt edin.

Excel sayfasında L19 hücresine aşağıdaki formülü uygulayın.

=R_TOPLA_SAY($D$28:$CM$80;B19;0)

Diğer hücreleri siz halledersiniz...

Değerli Korhan Ayhan üstad,
Söylediğiniz şekilde uyguladım ve mükemmel şekilde çalıştı. Hatta üç ayrı sayfada farklı organizasyon şemalarına uyguladım, her birinde mükemmel şekilde çalıştı, elinize sağlık çok teşekkür ederim.
Renk değişikliği denemeleri yaptığımda işlemin gerçekleşmesi için formül olan hücrelerden herhangi birine gidip enter yapılması durumunda renk sayma işlemi yapıyor, yani renk değişikliği yapıldığında otomatik olarak formüller çalışmıyor.
Her şey için tekrar teşekkür ediyor sağlıklı, huzurlu günler diliyorum.

 

[Korhan Ayhan]

Renk değişimlerinde F9 tuşuna basarsanız hesaplama otomatik yapılacaktır.

 

[msofuoglu]

Renk değişimlerinde F9 tuşuna basarsanız hesaplama otomatik yapılacaktır.

Teşekkür ederim Korhan Ayhan üstadım, sağlıklı huzurlu günler dilerim.