• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Renklere göre toplam

S

sinful

Banned
Katılım
29 Mayıs 2007
Mesajlar
155
Excel Vers. ve Dili
Office 2003
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,
 
A1:A100 arasındaki dediğiniz renkleri sayar.:cool:
Kod: 
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
 
Merhaba,
Basit birşey geldi aklıma..Ekli dosyayı inceleyin,bakalım işinizi görecek mi ?
Tamamen formülle yapılmıştır.
 

Ekli dosyalar

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ş.
 
sinful' Alıntı:
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ş.
Genişletmek için tıkla ...
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.:cool:
Bu şekilde sormanız lazım derim.:cool:
 
Evren Gizlen' Alıntı:
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.:cool:
Bu şekilde sormanız lazım derim.:cool:
Genişletmek için tıkla ...

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.
 
Şaban Bey,

Tam istediğim gibi olmuş ancak toplamayı yanlış yapıyor?
 
Son düzenleme:
Dosyanız ektedir.:cool:
Kod: 
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
 

Ekli dosyalar

sinful' Alıntı:
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.
Genişletmek için tıkla ...
(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.
 

Ekli dosyalar

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,
 
Son düzenleme:
Aşağıdaki KTF'yi yaptım.Kullanacağınız başka dosyalarda bu KTFyi o dosyada boş bir modüle kopyalayınız.:cool:
Kullanışı:
C14 hücresine aşağıdaki formül yazıldı ve kopyalandı.:cool:
dosya ektedir.:cool:
=renkli_topla($B14;C$4:C$12)
Kod: 
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
 

Ekli dosyalar

Evren Bey bu dosya mukemmel islevsel bunun fonta gore olani varmi acaba ?
 
sadece bilgi olarak istiyorum; zamaninizi alsin istemem sadece font rengi kirmizi, mavi, yesilse gibisinde editleyebiliyormuyuz formulu diye merak ettim..
 
mustafaine' Alıntı:
sadece bilgi olarak istiyorum; zamaninizi alsin istemem sadece font rengi kirmizi, mavi, yesilse gibisinde editleyebiliyormuyuz formulu diye merak ettim..
Genişletmek için tıkla ...
Font rengi için ilgili satır aşağıdaki ile değiştiriniz.:cool:
Kod: 
If hcr.font.colorindex = renk.font.ColorIndex Then
 
tesekkur ederim, kendim icin sakladim bunlar illaki gerekicektir bana, tesekkurler..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst