• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Renklere ve Değere Göre Sayma

A

Allback

Katılım
21 Eylül 2011
Mesajlar
115
Excel Vers. ve Dili
Office 365 - İngilizce
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.
 

Ekli dosyalar

muygun' Alıntı:
Merhaba;
Hücre rengini işlevlerle sayamazsınız.
ekteki makro çözümü deneyin.
İyi çalışmalar.
Genişletmek için tıkla ...

Ç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' Alıntı:
Forumda bolca örnek var.

Genişletmek için tıkla ...

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...
 
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.


C++: 
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
 
Allback' Alıntı:
hücre rengi veya içeriği değiştiğinde sonucun direkt değişmesini sağlayabilirsem tam olacak...
Genişletmek için tıkla ...

Sayfadaki renk değişimi makrodaki change olayını tetiklemez , sizin tekrar ilgili kullanıcı tanımlı fonksiyonu çalıştırmanız gerekir.
 
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.
 

Ekli dosyalar

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.
 
Ali' Alıntı:
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.
Genişletmek için tıkla ...
İ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.
 
Merhaba,

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

C++: 
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.

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

Diğer hücreleri siz halledersiniz...
 
  • Beğen
Reactions: Ali
Korhan Ayhan' Alıntı:
Merhaba,

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

C++: 
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.

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

Diğer hücreleri siz halledersiniz...
Genişletmek için tıkla ...
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.
 
Renk değişimlerinde F9 tuşuna basarsanız hesaplama otomatik yapılacaktır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst