Soru Renklere Göre Tarihe Dayalı Toplam Alma

Katılım
9 Ocak 2011
Mesajlar
354
Excel Vers. ve Dili
2007 Türkçe
Altın Üyelik Bitiş Tarihi
01-07-2023
Teşekkürler baya emek vermişsiniz elinize sağlık.

Size birşey sormak istiyorum bende Renklere göre K_RTOPLA koduyla listelerden Renklere göre verileri Topluyorum
Her Renk te çalışıyor ama bir türlü "Siyah" renk kullandığımda çalışmıyor. Bu normalmidir acaba?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Sanırım linkteki KTF'den bahsediyorsunuz.


Linkte #15 nolu mesajımda düzenleme yaptım. Son halini tekrar deneyiniz.
 
Katılım
9 Ocak 2011
Mesajlar
354
Excel Vers. ve Dili
2007 Türkçe
Altın Üyelik Bitiş Tarihi
01-07-2023
Merhaba,

Sanırım linkteki KTF'den bahsediyorsunuz.


Linkte #15 nolu mesajımda düzenleme yaptım. Son halini tekrar deneyiniz.
Korhan hocam merhaba
Evet Sizin verdiğiniz kod da siyah renk çalışmıyordu sağolun birazdan deneyeceğim burada konuyu görünce sorayım dedim.
Sizi yormak istememiştim size çok yük oldum. Her konuda yardımcı oluyorsunuz tekrar çok teşekkür ederim.
 
Katılım
9 Ocak 2011
Mesajlar
354
Excel Vers. ve Dili
2007 Türkçe
Altın Üyelik Bitiş Tarihi
01-07-2023
Deneyiniz.

Dosyanıza göre kullanım şekli;

B5;

C++:
=K_RTOPLA(KasaHesap!$C$5:$D$412;$A5;KasaHesap!$A$5:$A$412;">="&B$4;KasaHesap!$A$5:$A$412;"<="&SERİAY(B$4;0))

KTF kodları;

C++:
Option Explicit

Function K_RTOPLA(Toplanacak_Alan As Range, Renk_Kodu As Variant, _
    Kriter_Alanı_1 As Range, Kriter_1 As Variant, _
    Kriter_Alanı_2 As Range, Kriter_2 As Variant)

    Dim Veri As Range, Sütun_Say As Integer, Say As Long

    Application.Volatile
   
    Say = 1
   
    For Each Veri In Toplanacak_Alan
        Sütun_Say = Sütun_Say + 1
        If Sütun_Say > Toplanacak_Alan.Columns.Count Then
            Say = Say + 1
            Sütun_Say = 1
        End If
        If Veri.Font.Color = Renk_Kodu.Font.Color Then
            If Evaluate(CLng(Kriter_Alanı_1.Cells(Say, 1)) & Kriter_1) Then
                If Evaluate(CLng(Kriter_Alanı_2.Cells(Say, 1)) & Kriter_2) Then
                    K_RTOPLA = K_RTOPLA + Veri.Value
                End If
            End If
        End If
    Next
End Function
Yapmış olduğunuz ilave ile Siyah Renkte de çalıştı Korhan hocam tekrar teşekkürler.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,190
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Aslında fonksiyonda renk tanımı ile bir sorun yoktu.

Siz aralık seçiminizde başlıkları dahil ettiğiniz için fonksiyon içinde kullanılan tarihi kontrol eden satır metinsel ifadelerde hata verip fonksiyonu sonlandiriyordu. Koda sadece bu kontrolü ekleyince sorun düzelmiş oldu.
 
Üst