Renkli Hücrelerin Toplanması Yardım

[skaan]

Merhaba;
Renkli Hücrelerin Toplanması ile ilgili aşağıdaki kodları kullanmaktayım fakat hücre rengi değiştiğinde Renklitopla formulu otomatik olarak toplama yapmıyor. F2 ye basınca formül toplama yapıyor. Ancak toplam alamıyorum..Hücre rengini değiştiği anda formulun dogru çalışmasını nasıl sağlayabilirim.
Örnek dosyam ektedir.
Dosyamın Module bölümüne :

Function Renklitopla(InRange As Range, WhatColorIndex As Integer, _
Optional OfText As Boolean = False) As Double
Dim Rng As Range
Dim OK As Boolean
Application.Volatile True
For Each Rng In InRange.Cells
If OfText = True Then
OK = (Rng.Font.ColorIndex = WhatColorIndex)
Else
OK = (Rng.Interior.ColorIndex = WhatColorIndex)
End If
If OK And IsNumeric(Rng.Value) Then
Renklitopla = Renklitopla + Rng.Value
End If
Next Rng
End Function

yazıyorum.

Fromül : =Renklitopla($E$3:$E$49;37;YANLIŞ)

Yardımcı olmanızı rica ediyorum.

Saygılarımla;
Skaan

 

[Korhan Ayhan]

Merhaba,

Hücrenin rengi değiştiğinde sayfada hiçbir olay tetiklenmez. Bu sebeple istediğiniz işlem için tam çözüm yoktur. Dolaylı olarak çözümler üretebiliriz.

Bunlardan ilki hücre rengi değiştirdikten sonra F9 tuşuna basmak.
İkincisi ise sayfanın hücre değişimi olayına hesaplama işlemini yapacak kodu uygulamaktır.

Renk değişikliği yaptıktan sonra farklı bir hücreye tıkladığınızda formülünüz sonuç üretecektir.

BuÇalışmaKitabı bölümüne uygulayınız.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.Calculate
End Sub

 

[skaan]

Yardımlarınız için teşekkürler.
Sağolun.
Saygılar
Skaan