Soru İsim Renklendirme

[k0081]

Merhaba arkadaşlar;

command buton ile ;

C2:C65 aralığındaki

KADİR KARA yı kırmızı ( 3), MURAT YILDIZ ı yeşil (14) ERGÜN KESKİN i mavi (23) nasıl yapabilirim ?


Yardımcı arkadaşa şimdiden Teşekkürler.

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub kod()
Dim hcr As Range
Dim renk As Byte
For Each hcr In Range("C2:C65")
    Select Case hcr.Value
        Case Is = "KADİR KARA"
            renk = 3
        Case Is = "MURAT YILDIZ"
            renk = 14
        Case Is = "ERGÜN KESKİN"
            renk = 23
        Case Else
            renk = 0
    End Select
    hcr.Interior.ColorIndex = renk
Next
End Sub

 

[k0081]

Hocam Hücre rengini değilde sadece Font rengini değiştireceğiz. Teşekkürler.

****************

hcr.Font.ColorIndex = renk olarak değiştirdim. kırmızı ile mavi oldu.

fakat yeşil biraz farklı duruyor.. renk kodunu alıyorum değişmiyor. ama renk farklı...

Teşekkür ederim.

 

[k0081]

ÖmerBey;

14 nolu Rengi 4 nolu renk yaptım Düzeldi.

Çok Teşekkürler Hocam. Tamamdır... Elinize sağlık.

 

[ÖmerBey]

Ben de tam onu soracaktım, siz yazmışsınız.
Sorunu uğraşarak çözmeniz çok güzel, tebrik ederim.
İyi çalışmalar...

 

[k0081]

hocam ;

Bu renklere göre nasıl toplatabilirim ? command buton ile..?

F2:F63 arasında renkli sayılar mevcut...

 

[ÖmerBey]

İsme göre toplatmak daha mantıklı değil mi? Tabii her renk farklı isimse...
Renge göre de döngü kurularak toplatabilirsiniz, ama hangi hücredeki renge göre hangi hücre toplanacak?

 

[k0081]

ÖmerBey;

Hocam şöyle;

Şimdi o isimlerin karşılığında saatler var. hesaplanmış durumda ve renkli.

3 farklı renk. bunları toplasın istiyorum. isimleri değil..

örnek :

kırmızıdan (3) 10 tane var diyelim. ama istenen bu 10 değil... karşılığındaki saat değeri.. kiminde 9 , kiminde 15 vs..

 

[ÖmerBey]

Sormak istediğim şey şu?
1. İlk sorunuza göre C2:C65 aralığında isimler var, karşısında da saatler var, peki ne kadar karşısında? D sütununda mı, yoksa farklı bir sütunda mı?
2. Hangi sütundaki renge göre işlem yapılacak, isimlerin rengine göre mi saatlerin rengine göre mi?
3. Yazı rengine göre mi, arka plan rengine göre mi?
...

 

[k0081]

Sormak istediğim şey şu?
1. İlk sorunuza göre C2:C65 aralığında isimler var, karşısında da saatler var, peki ne kadar karşısında? D sütununda mı, yoksa farklı bir sütunda mı?
2. Hangi sütundaki renge göre işlem yapılacak, isimlerin rengine göre mi saatlerin rengine göre mi?
3. Yazı rengine göre mi, arka plan rengine göre mi?
...

1. F2:F63 aralığında saatler var. hesaplanmış durumda sadece rakam. renkli.
2. I6=3 I7=4 I8=23 renkler buradan alınabilir... >>> Saatlerin rengine göre işlem yapacağız. oda F2:F63 aralığındadır.
3. Yazı rengine göre.

 

[Necdet]

Merhaba,

Buraya Baktınız mı?.

 

[k0081]

Necdet ;

Arama yapmıştım. bu kısmı göremedim. Şimdi baktım fakat dosyaları indiremediğim için , çok bi faydası olmadı açıkcası.

 

[ÖmerBey]

Deneyiniz...

Sub kod()
Dim s1 As Double, s2 As Double, s3 As Double
Dim hcr As Range
For Each hcr In Range("F2:F63")
    If hcr.Font.ColorIndex = Range("I6").Value Then
        s1 = s1 + hcr.Value
    ElseIf hcr.Font.ColorIndex = Range("I7").Value Then
        s2 = s2 + hcr.Value
    ElseIf hcr.Font.ColorIndex = Range("I8").Value Then
        s3 = s3 + hcr.Value
    End If
Next
Range("J6") = s1
Range("J7") = s2
Range("J8") = s3
End Sub

Alternatif olarak rengi hücre dolgusundan aldırarak aşağıdaki şekilde de kullanabilirsiniz.

Sub kodd()
Dim s1 As Double, s2 As Double, s3 As Double
Dim hcr As Range
For Each hcr In Range("F2:F63")
    If hcr.Font.Color = Range("I6").Interior.Color Then
        s1 = s1 + hcr.Value
    ElseIf hcr.Font.Color = Range("I7").Interior.Color Then
        s2 = s2 + hcr.Value
    ElseIf hcr.Font.Color = Range("I8").Interior.Color Then
        s3 = s3 + hcr.Value
    End If
Next
Range("I6") = s1
Range("I7") = s2
Range("I8") = s3
End Sub

 

[k0081]

Kodları uyguladım. Ama ilk göndermiş olduğunuz kod ile (toplam-1 butonu) sonuçları 0 veriyor.

alternatif kodu değiştirip (toplam-2 butonu) uyguladığımda iki kişinin sonucunu veriyor.. diğeri yok.

Sayfa1.xlsm dosyasını indir - download

Sayfa1.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

 

[ÖmerBey]

Kodları F8 ile adımlarsanız hatanın kaynağını bulabilirsiniz. Benim tahminim şu yönde:
İlk kod için 10 numaralı mesajda belirttiğiniz üzere I6, I7, ve I8 de sırasıyla 3, 4 ve 23 yazmalı.
İkinci kodda da bir renk uyuşmazlığı var muhtemelen.

 

[k0081]

dediğiniz gibi yaptım adım adım incelediğimde ;

s3 = s3 + hcr.Value --> bu satırı hiçbir şekilde işletmiyor., Atlıyor.

 

[ÖmerBey]

Bilgisayar başında olmadığım için dosyanızdan kontrol edemiyorum.
2. Kod için s3 = s3 + hcr.Value satırının altına, End If satırından önce

Else
Msgbox hcr.Font.Color & vbLf & Range("I8").Interior.Color

satırlarını ilave ederseniz bir kod uyuşmazlığı olup olmadığını kontrol edebilirsiniz.

 

[k0081]

Tamamdır Düzeldi Hocam. yani Aynı kısımda sıkıntı oldu. renk kodu 23 --> 5 yaptım. Hesapladı.

Teşekkürler.