Renge göre satır saydırma.

[hhalil]

Merhaba,satır rengine saydırmak istiyorum.
Teşekkür ederim.

 

[Merhum İdris SERDAR]

Aşağıdaki kodu kullanabilirsiniz.

Function rnksay(aln As Range, krt As Range) As Long

    Dim aln2 As Range
    Dim rnk As Long
rnk = krt.Interior.ColorIndex

For Each aln2 In aln
    If aln2.Interior.ColorIndex = rnk Then
        rnksay = rnksay + 1
    End If
Next aln2

End Function

Dosyanız ekte.

.

 

[hhalil]

Aşağıdaki kodu kullanabilirsiniz.

Function rnksay(aln As Range, krt As Range) As Long

    Dim aln2 As Range
    Dim rnk As Long
rnk = krt.Interior.ColorIndex

For Each aln2 In aln
    If aln2.Interior.ColorIndex = rnk Then
        rnksay = rnksay + 1
    End If
Next aln2

End Function

Dosyanız ekte.

.

Sayın SERDAR,ilginize çok teşekkür ederim.

 

[hhalil]

Satır renkleri değiştiği zaman k2-k3-k4 deki veriler değişmiyor çözümü var mı acaba?

 

[Merhum İdris SERDAR]

Formüllere girip, Enter'e basmanız gerekir.

 

[hhalil]

İdris bey,sizin yolladığınız formülü yazıp Enter'e basınca sonuç bulunuyor fakat sayfa içinde satır renkleri işlem yaptıkça değişiyor lakin sonuç değişmiyor!
Teşekkürler

 

[Merhum İdris SERDAR]

Aşağıdaki kodları sayfa Koduna yazın.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Calculate
End Sub

 

[Korhan Ayhan]

Alternatif;

Fonksiyondaki "Application.Volatile True" satırı dinamik hesaplaması için kullanılmıştır.

Function Renk_Say(Alan As Range, Hangi_Renk As Range)
    Application.Volatile True
    Renk_Kodu = Hangi_Renk.Interior.ColorIndex
    For Each Veri In Alan
        If Veri.Interior.ColorIndex = Renk_Kodu Then
            Renk_Say = Renk_Say + 1
        End If
    Next
End Function

 

[hhalil]

Sayın Ayhan ve Serdar ilginize ve emeğinize sağlık teşekkürler.