KTF: Renkli Hücreleri Toplama ve Sayma tamam Peki Alttoplam istersek nasıl olmalı?

[hsayar]

http://www.excel.web.tr/showthread.php?p=244969#post244969

merhaba arkadaşlar yukarıdaki linkte işlenen ve aşağıda kodlar ile Bir aralıkta (e2:e100) belirtilen tüm hücreleri rengine göre topluyoruz peki d sü tütununda veri filtreleme uyguladık ve renkli hücrelerin bir kısmı gözükmeyen alanda kaldı

Normol toplama istesek =alttoplam(9;e2:e100) deriz filtrelenmiş alanın toplamını elde ederiz.

peki filtrelenmiş alandaki renkli hücrelerin toplamı nasıl elde edilir?

Saygılarımla.

Function brdrenktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer)
Dim c As Range
On Error Resume Next
Toplam = 0
If islem = 1 Then
    For Each c In Adres
       If c.Interior.ColorIndex = Dolgu_rengi And c.Font.ColorIndex = Font_rengi And c <> "" Then Toplam = Toplam + c.Value
    Next
End If
brdrenktopla = Toplam
End Function

 

[Necdet]

Merhaba,

Aklıma birşeyler geliyor ama şu anda yapacak halim yok Sayın hsayar

Aklıma gelen şey şu:

Makro ile örnek bir hücre seçilir (tabi bu sizin istediğiniz renklere sahip olan hücredir), dosyanın sağ tarafında boş bir sütunda istediğiniz özelliklere sahap olan satırlar için 1 diğerleri için 0 yazdırılır ve bu değerlere göre Süz(Filter) yaptırılır.

Klasik ALTTOPLAM fonksiyonu ile de toplam aldırılır.

 

[hsayar]

bu dediğiniz anladım hocam bencede olabilir... ancak 2500 satılık veride filtre içinde sarı dolgulu beyaz yazılı olan hücreleri 1 yapmak epey uzun sürecektir.

kontrolü filtrelenmiş sütunda uygulayabilirsek belki daha hızlı olur. neyse müsait olunca bakarsınız bende yarın işyerinde vakit bulursam verdiğiniz ilham ile naçizane birşeyler yapmaya çalışırım.

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdaki kodlar belki size ilham verebilir. Bu fonksiyon, bir aralıktaki "görünür hücrelerden" sadece kırmızı renkli olanları toplayarak bir sonuç döndürür. Siz, farklı koşullarda daha ilave ederek geliştirebilirsiniz.

Public Function OzelTopla(rg As Range)
Dim hcr As Range
Application.Volatile
For Each hcr In rg.Cells
    If hcr.Rows.Hidden = False Then
       If hcr.Font.ColorIndex = 3 Then
          deger = deger + hcr.Value
       End If
    End If
Next
OzelTopla = deger
End Function

 

[hsayar]

Teşekkürler Hocam; peki
Application.Volatile
satırının anlamı nedir?

ve değer girilmezse varsayılan değer tanımlabilirmi

Mesala
Function brdrenktopla(Adres As Range, Dolgu_rengi, Font_rengi, islem As Integer)

Satırını çağırrken brdrenktopla(a1:a100, 3, 8, 1) diye çağırıyoruz
şu eşkilde çağırdımızda da olmayan değer otomatik gelsin
brdrenktopla(a1:a100, , 10, )
bu çağrım ile a1:a100 aralığında dolgurenk değeri 3 olanlar (Otomatik gelecek), Font rengi 10 olanlar, 1 nolu işlem (otomatikj gelecek)

mümkünmüdür?

gerçi bana paramaetrik prosodürde alzım ama fonksiyon için olanını da öğrenmenin zararı olmaz

Saygılarımla hayırlı geceler

 

[Ferhat Pazarçevirdi]

Eğer bu fonksiyonu, bir makro kodu içerisinde, bir değer üretmek için kullanacaksanıza, Volatile'in pek bir önemi olmayabilir.

Ancak, söz konusu function, sayfa üzerinde herhangi bir hücreye yazılan formül niteliğini alacaksa, Volatile hayati önem taşır.

Volatile, kullanmadan böyle bir KTF'nin; değer güncellemesi beklenemez.

Şöyle ki; siz A1 hücresini değiştirdiğinizde, normalde formülün de kendini güncellemesini beklersiniz. Ama Application.Volatile kullanmasaydık, hücre değerini değiştirmeniz halinde bile, fonksiyon hesaplama yapmayacaktı. Bu olay, sanki "Hesaplama"nın Manuel'e dönmesini hatırlatır.

Kodları, Volatile satırını iptal ederek ve barındırarak, deneme yapınız daha iyi anlayacaksınız.

 

[hsayar]

teşekkür ederim hocam, teşekkür mesajımda (5 nolu) düzeltme yapmıştım ek konu hakkındada fikrinizi söylermisiniz?

 

[Ferhat Pazarçevirdi]

Sizin fonksiyonun tamamını bilemediğim için benim daha önce verdiğim örnek üzerinden gidelim.

Eski fonksiyonumuzda, sadece kırmızı renkli hücrelerin toplanmasını istiyorduk ve bunun için sadece aralık belirlememiz yeterliydi.
Yani "=OzelTopla(A2:A28)" şeklinde ...

Yine aynı işi yapan ama renk opsiyonunu da ihtiva eden daha geliştirilmiş bir fonksiyon aşağıdadır. Burada renk parametresi opsiyonel bırakılmıştır. Yani yazılsa da olur, yazılmasa da ... Yazılmazsa, '=OzelTopla(A2:A28) gibi' default olarak "görünen kırmızı renkli hücreleri" toplar, yazılırsa '=OzelTopla(A2:A28;4)' gibi belirtilen renk index'ine uyan "görünür hücreleri" toplar.

Daha önce verdiğim kodla; yeni kodun arasındaki farklar kırmızı olarak gösterilmiştir.

Function OzelTopla(rg As Range, [COLOR=red]Optional renk As Integer[/COLOR])
Dim hcr As Range
Application.Volatile
[COLOR=red]If renk = 0 Then: renk = 3[/COLOR]
For Each hcr In rg.Cells
    If hcr.Rows.Hidden = False Then
       If hcr.Font.ColorIndex = [COLOR=red]renk [/COLOR]Then
          deger = deger + hcr.Value
       End If
    End If
Next
OzelTopla = deger
End Function

 

[hsayar]

teşekkür ederim hocam genel uygulamadada inşallah başarılı olurum.

 

[Necdet]

Sayın hsayar,

Örnek dosya ekleseniz şimdiye kadar çok hızlı şekilde çözüm alırdınız. İnanın son günlerde öylesine tembelimki, birşeyler yapıp kontrol etmek için data gerek, oysa data yok. Olmayınca da kod yazmada tembelleşiyorum.

 

[hsayar]

sn necdet yesertener soruma cevap ladım ve denememde başarılı oldum ... iginize teşekkür ederim.
gnelke uyguklma derken renli hücrelrde FİLTRELENMİŞ JHÜCRELER alttoplM FONKİSYONUNUN tüm özelliklerini kazandıracak bir fonkisyon hazırlamak ma bugün çok yoğundum yarın kısmet.

 

[Necdet]

Merhaba,

Basit bir örnekte benden :

Public Sub BulveSüz()
On Error Resume Next
ActiveSheet.ShowAllData
[C2:C1000].ClearContents
For i = 2 To [A65536].End(3).Row - 1
    If Selection.Font.ColorIndex = Cells(i, "A").Font.ColorIndex And _
       Selection.Interior.ColorIndex = Cells(i, "A").Interior.ColorIndex Then Cells(i, "C") = 1
Next i
    Range("A1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=3, Criteria1:="1"
End Sub