Renklere göre toplam

[sinful]

Arkadaşlar selam,

Bir sütunda farklı renklerle temsil edilen (4 farklı renk, mavi-yeşil-sarı-kırmızı) hücreler mevcuttur.Bu hücreleri renklerine göre nasıl toplatabiliriz yardımcı olursanız çok sevinirim. Forumda arattım benzer bir topiğe rastladım ancak tıkladığımda sayfa hata veriyor sanırım database'den silinmiş. Tekrar teşekkürler.

Saygılarımla,

 

[Orion1]

A1:A100 arasındaki dediğiniz renkleri sayar.

Sub renkler()
Dim mavi As Long, sari As Long, yesil As Long, kirmizi As Long
Dim hcr As Range
For Each hcr In Range("A1:A100")
    Select Case hcr.Interior.Color
        Case vbBlue: mavi = mavi + 1
        Case vbYellow: sari = sari + 1
        Case vbGreen: yesil = yesil + 1
        Case vbRed: kirmizi = kirmizi + 1
    End Select
Next hcr
MsgBox "Mavi :" & vbTab & mavi & vbLf & _
"Sarı :" & vbTab & sari & vbLf & "Yeşil :" & vbTab & yesil & _
vbLf & "Kırmızı :" & vbTab & kirmizi, vbOKOnly + vbInformation, "RENKLER"
End Sub

 

[hayri tekin]

Merhaba,
Basit birşey geldi aklıma..Ekli dosyayı inceleyin,bakalım işinizi görecek mi ?
Tamamen formülle yapılmıştır.

 

[sinful]

Sayın Evren,

Renkli hücreleri saydırmak değilde her rengi kendi kutucuğunda toplatmak istiyorum.Örneğin A1:A100'e kadar sütünda mavi sarı yeşil ve kırmızı renkli hücreler mevcut. A101 hücresinde mavi renkleri, A102 hücresinde sarı renklileri, A103 hücresinde yeşil renklileri vs toplatmak istiyorum.Sayın tekinek teşekkür ederim ancak sizin çözümünüz biraz daha farklı olmuş.

 

[Orion1]

Sayın Evren,

Renkli hücreleri saydırmak değilde her rengi kendi kutucuğunda toplatmak istiyorum.Örneğin A1:A100'e kadar sütünda mavi sarı yeşil ve kırmızı renkli hücreler mevcut. A101 hücresinde mavi renkleri, A102 hücresinde sarı renklileri, A103 hücresinde yeşil renklileri vs toplatmak istiyorum.Sayın tekinek teşekkür ederim ancak sizin çözümünüz biraz daha farklı olmuş.

A 101 içerisindeki mavi renkler ne oluyor.Hücre içinde arka plan bir renk olur.Dolayısı ile renkler olmaz.Siz mavi renk olan hücrelerin içindeki sayıları toplatıcam diyorsanız o zaman sorunuzu yanlış sormuşsunuz derim.
Bu şekilde sormanız lazım derim.

 

[sinful]

A 101 içerisindeki mavi renkler ne oluyor.Hücre içinde arka plan bir renk olur.Dolayısı ile renkler olmaz.Siz mavi renk olan hücrelerin içindeki sayıları toplatıcam diyorsanız o zaman sorunuzu yanlış sormuşsunuz derim.
Bu şekilde sormanız lazım derim.

Sayın Evren,

Sütundaki mavi renk olan hücrelerin içideki sayları bir hücrede, sarı olanları başka bir hücrede vs toplatmak istiyorum.

 

[Skorpiyon]

Sayın sinful,

İstediğiniz böyle bir şey midir ?

 

[sinful]

Şaban Bey,

Tam istediğim gibi olmuş ancak toplamayı yanlış yapıyor?

 

[Orion1]

Dosyanız ektedir.

Sub renktopla()
Dim hcr As Range, mavi As Double, kirmizi As Double, sari As Double, yesil As Double
For Each hcr In Range("A1:C5")
    Select Case hcr.Interior.Color
        Case vbRed: kirmizi = kirmizi + hcr.Value
        Case vbYellow: sari = sari + hcr.Value
        Case vbGreen: yesil = yesil + hcr.Value
        Case vbBlue: mavi = mavi + hcr.Value
    End Select
Next
MsgBox "Kırmızı : " & vbTab & kirmizi & _
vbLf & "Sarı : " & vbTab & sari & _
vbLf & "Yesil : " & vbTab & yesil & _
vbLf & "Mavi : " & vbTab & mavi & vbLf & _
vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Ali]

Arkadaşlar selam,

Forumda arattım benzer bir topiğe rastladım ancak tıkladığımda sayfa hata veriyor sanırım database'den silinmiş. Tekrar teşekkürler.

Saygılarımla,

Burada zaten bir çalışma yaptık.

Renkli zemin ve Font Özelliklerine Göre Uygulamalar

.

 

[Skorpiyon]

Sayın Evren,

Sütundaki mavi renk olan hücrelerin içideki sayları bir hücrede, sarı olanları başka bir hücrede vs toplatmak istiyorum.

(6 nolu mesaj)


Sayın sinful,

Toplama işlemi doğru yapılmaktadır.

Ne istediğinizi daha net ifade etmelisiniz. Ben yine de 2. bir buton ekleyerek dosyayı yeniden gönderiyorum. Hangisi lazımsa onu kullanırsınız.

 

[sinful]

Arkadaşlar kusura bakmayın bayram nedeniye forumdan uzak kaldım.Hepinizin teker teker ellerinize sağlık. Ekli dosylara işime yarayabilir ancak macro bilmediğim için çoklu satır için nasıl adapte edilir bilemiyorum.Size ekte gönderdiğim dosyada yapmaya çalıştığımı daha iyi anlayabilirsiniz.Yardımınız ve ilginiz için sonsuz teşekkürler.

Saygılarımla,

 

[sinful]

Örnek ektedir.

 

[Orion1]

Aşağıdaki KTF'yi yaptım.Kullanacağınız başka dosyalarda bu KTFyi o dosyada boş bir modüle kopyalayınız.
Kullanışı:
C14 hücresine aşağıdaki formül yazıldı ve kopyalandı.
dosya ektedir.
=renkli_topla($B14;C$4:C$12)

Function renkli_topla(renk As Range, alan As Range)
Dim toplam As Double, hcr As Range
For Each hcr In alan
    If hcr.Interior.ColorIndex = renk.Interior.ColorIndex Then
        toplam = toplam + hcr.Value
    End If
Next
renkli_topla = toplam
End Function

 

[mustafaine1]

Evren Bey bu dosya mukemmel islevsel bunun fonta gore olani varmi acaba ?

 

[Orion1]

Evren Bey bu dosya mukemmel islevsel bunun fonta gore olani varmi acaba ?

Nasıl bir şey istiyorsunuz.Örnek dosya yollayıp açıklarsanız hallederiz.

 

[mustafaine1]

sadece bilgi olarak istiyorum; zamaninizi alsin istemem sadece font rengi kirmizi, mavi, yesilse gibisinde editleyebiliyormuyuz formulu diye merak ettim..

 

[Orion1]

sadece bilgi olarak istiyorum; zamaninizi alsin istemem sadece font rengi kirmizi, mavi, yesilse gibisinde editleyebiliyormuyuz formulu diye merak ettim..

Font rengi için ilgili satır aşağıdaki ile değiştiriniz.

If hcr.font.colorindex = renk.font.ColorIndex Then

 

[mustafaine1]

tesekkur ederim, kendim icin sakladim bunlar illaki gerekicektir bana, tesekkurler..

 

[Orion1]

tesekkur ederim, kendim icin sakladim bunlar illaki gerekicektir bana, tesekkurler..

Rica ederim.