süz daha sonra topla

[kdr20_88]

renk topla işini çözdüm... sizden istediğim aralık ayını süzdükten sonra sadece aralık ayındaki sarı renkleri toplasın...
örnek tablomu inceler ve yardım ederseniz minnettar olurum.

 

[kdr20_88]

excel ustaları mutlaka yardımınızı bekliyorum...

 

[kdr20_88]

yok mo.. kimse yapamaz mıı

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki fonksiyonu kullanabilirsiniz.

Hücrede kullanım şekli;

[B][COLOR=blue]=RENKLİ_TOPLA(Hücre_Aralığı;Renk_Kodu;Filtre_Kontrol)[/COLOR][/B]

Renk_Kodu ve Filtre_Kontrol kriterleri opsiyoneldir.

Renk_Kodu olarak opsiyonel sarı (6) renk tanımlanmıştır. Bu kriteri boş bıraksanız dahi sarı renge göre hesaplama yapacaktır. Farklı renk kodlarıda kullanabilirsiniz.

Filtre_Kontrol ise False olarak tanımlanmıştır. Sayfada filtre olsa dahi bu değeri False (0) olarak kullanırsanız filtre yokmuş gibi davranarak tüm hücreleri toplayacaktır.

Eğer sayfada filtre uygulanmışsa ve siz bu kriteri boş bırakırsanız ya da True (1) olarak kullanırsanız görünür hücrelerdeki renkli hücreleri toplayacaktır.

Ekteki örnek dosyada uyarlaması yapılmıştır. İncelermisiniz.


Kullanılan kod;

Option Explicit
 
Function RENKLİ_TOPLA(Aralık As Range, Optional Renk_Kodu As Byte = 6, _
Optional Filtre_Kontrol As Boolean = False)
    Dim Hücre As Range, Son_Sütun As Integer, X As Integer
    
    Application.Volatile True
    
    If ActiveSheet.FilterMode And Filtre_Kontrol = False Then
        Son_Sütun = ActiveSheet.AutoFilter.Filters.Count
        
        For X = 1 To Son_Sütun
            If ActiveSheet.AutoFilter.Filters.Item(X).On Then
                Filtre_Kontrol = True
                Exit For
            End If
        Next
    End If
    
    If Filtre_Kontrol = True Then
        For Each Hücre In Aralık
            If Hücre.Interior.ColorIndex = Renk_Kodu Then
                If Hücre.Height <> 0 Then
                    RENKLİ_TOPLA = RENKLİ_TOPLA + Hücre.Value
                End If
            End If
        Next
    Else
        For Each Hücre In Aralık
            If Hücre.Interior.ColorIndex = Renk_Kodu Then
                RENKLİ_TOPLA = RENKLİ_TOPLA + Hücre.Value
            End If
        Next
    End If
End Function

 

[kdr20_88]

minnettarım ustam size. çok teşekkür ederim... tamda işimi gördü