tarihe bağlı renkli hücre saymak hakkında

[hakanarik]

merhabalar, renkli hücre saydırma ile ilgili bilgiler buldum internetteki araştırmalarımda ancak, belirli tarih aralığındaki renkli hücre saydırma ile ilgili macro bulamadım. yardımcı olursanız sevinirim. (hücrelerin içerisinde tarih yazılı)

 

[Mustafa MUTLU]

Hangi hücreler ve ne kadar veri var ?.
Bilgileri örneklerseniz daha fazla ilgi çeker

 

[Mustafa MUTLU]

Veriler b sütununda olduğunu düşünelim
c1 de ilk tarih
d1 de son tarih olacak
hücre renkleride kırmızı olsun.
E1 hücresine sonucu yazar.

Sub RENK()
    For MM = 2 To 50
        If Cells(KK, "B") > Cells(1, "C") And Cells(KK, "B") < Cells(1, "D") Then
        If Cells(MM, "B").Interior.ColorIndex = 3 Then
        NN = NN + 1
        End If
        End If
        Cells(1, "E") = IIf(NN <> 0, NN, "")
    Next
End Sub

 

[muygun]

Merhaba;
Alternatif olsun.
Ekteki gibi olabilir.
Kendi dosyanıza uyarlayın.
İyi çalışmalar.

Link:
http://s6.dosya.tc/server10/ht3e8z/hakanarik-sayma.zip.html

 

[numan şamil]

Merhaba
Alternatif olsun

Sub RENK()
Range("E1").ClearContents
For i = 2 To 50
If Cells(i, "B") > Cells(1, "C") And Cells(i, "B") < Cells(1, "D") Then
If Range("b" & i).Interior.ColorIndex = 3 Then
say = say + 1
End If
End If
Next
Range("E1") = say
End Sub

 

[hakanarik]

bu kadar çabuk geri dönüşünüz için teşekkürler. benim istediğim =renklihücresay(L:R;">25.07.17";L:R;"<=25.08.17") bu mantıkta birşey olmasını istiyorum aslında yani iki koşul olacak hem dolgulu hücre hem belirtilen tarihler arasında olacak umarım anlatabilmişimdir.

 

[Ömer BARAN]

bu kadar çabuk geri dönüşünüz için teşekkürler. benim istediğim =renklihücresay(L:R;">25.07.17";L:R;"<=25.08.17") bu mantıkta birşey olmasını istiyorum aslında yani iki koşul olacak hem dolgulu hücre hem belirtilen tarihler arasında olacak umarım anlatabilmişimdir.

Merhaba.

Aşağıdaki gibi bir KTF oluşturdum, deneyiniz.

-- Aşağıdaki kod'u boş bir MODULE'e yapıştırın.
.

[B]Function renksay(alan As Range, tarih1 As Date, tarih2 As Date, kriter As Range) As Long[/B]
    Dim veri As Range
    Dim renk As Long
    renk = kriter.Interior.ColorIndex
For Each veri In alan
    If veri.Interior.ColorIndex = renk And veri >= tarih1 And veri <= tarih2 Then
        renksay = renksay + 1
    End If
Next veri
[B]End Function[/B]

-- Kullanılmayan bir hücreye aşağıdaki formülü yazın.
.

[SIZE="4"][B][COLOR="Red"]=renksay([/COLOR][/B][B]G2:H9[/B];[COLOR="Blue"]A1[/COLOR];[COLOR="SeaGreen"]B1[/COLOR];[COLOR="DarkOrange"]C1[/COLOR][B][COLOR="red"])[/COLOR][/B][/SIZE]

[COLOR="Red"]Formülün yapısı:[/COLOR]
[B][COLOR="red"]=renksay([/COLOR][/B][B]sayımyapılacakalan[/B];[COLOR="Blue"]küçüktarih[/COLOR];[COLOR="SeaGreen"]büyüktarih[/COLOR];[COLOR="DarkOrange"]kriterrenkileboyanmışhücre[/COLOR][B][COLOR="red"])[/COLOR][/B]

 

[hakanarik]

Çok teşekkür ederim, şimdi denedim çalışıyor. tarihler de ayarladım. elinize emeğinize sağlık. kendim olsam hayatta yapamazdım kod yazma işinden hiç anlamıyorum. ilk kez makroya işimiz düştü sağlıcakla kalın.

 

[numan şamil]

merhaba
muygun Hocamdan esinlenerek hazırlanmış kodlar
Alternatif olsun

Sub numan()
 Dim alan As Range
    Dim veri As Range
    Dim renk As Long
    Set alan = Application.Range("G2:H9")
    renk = Range("C1").Interior.ColorIndex
    tarih1 = Range("A1")
     tarih2 = Range("B1")
     Range("E1") = ""
For Each veri In alan
    If veri.Interior.ColorIndex = renk And veri >= tarih1 And veri <= tarih2 Then
    Range("E1").Value = Range("E1").Value + 1
    End If
Next veri
End Sub