Koşullu biçimlendirme dolgu sorunu

[kargec]

Arkadaşlar selamlar.
Hücre dolgu rengini kendim seçip, hücreyi kırmızı renk ile doldurdup, renk sorgusu ile sorguladığımda 3 ( Kırmızı ) rengini veriyor. Burda sorun yok ve doğru.

Ancak hücre dolgu rengini koşullu biçimlendirme ile yaptığımda kırmızı dolguyu seçtiğim halde renk sorgusu -4142 ( Beyaz ) sonucunu vermekte.

Bu sorunu nasıl giderebilirim.

Saygılar..

 

[Murat OSMA]

Hücrenin DisplayFormat özelliğini kullanarak sorgulayın.​

 

[kargec]

Hücrenin DisplayFormat özelliğini kullanarak sorgulayın.​

Rica etsem yardımcı olur musunuz ?

 

[Korhan Ayhan]

Deneyiniz.

Sub TEST()
    If Range("A1").DisplayFormat.Interior.ColorIndex = 3 Then
        MsgBox "A1 hücresindeki renk kırmızıdır..."
    End If
End Sub

 

[kargec]

Deneyiniz.

Sub TEST()
    If Range("A1").DisplayFormat.Interior.ColorIndex = 3 Then
        MsgBox "A1 hücresindeki renk kırmızıdır..."
    End If
End Sub

İlgin için teşekkürler kardeşim.
Ancak benim istediğim bu değildi. makrosuz koşullu biçimlendirmede hücre değerini 3 vermesi.

 

[Korhan Ayhan]

Siz hücre rengini nasıl sorguluyorsunuz?

 

[kargec]

Siz hücre rengini nasıl sorguluyorsunuz?

=EĞER($M$2=1;$L$12:$M$12) Kırmızı
Hücre değeri büyük =$L$3 =$L$4:$L$26 Kırmızı
Hücre değeri arasında =$K$6 =$L$3 Yeşil

Bunun gibi onlarca sorgu var kardeşim.

Tamam kırmızı diyorsam kırmızı, yeşil diyorsam yeşil dolgu yapıyor. Ancak sorun şuki; Koşullu biçimlendirmede renkler hücrelerin sadece üstünü belirtilen renklerle örtüyor gerçekte taban rengi hep beyaz kalıyor.

Bu makroyu bir modüle yapıştırıyorum.

Function ColorIndex(CellColor As Range)

ColorIndex = CellColor.Interior.ColorIndex

End Function

bunuda boş bir hücreye yapıştırıyorum.

=ColorIndex(Buraya sorguladığım hücrenin adını yazıyorum örneğin L12)

Hücre rengini kırmızı dolgulu görüyorum ve sonuç -4142 yani beyaz (3 olması lazım)

Hücre rengini yeşil dolgulu görüyorum ve sonuç -4142 yani beyaz (14 olması lazım)

Programda bir hücre için (< se) (> se) (= se) ( Arasında ise) sorguları çalışıyor. hepside sorunsuz. Ancak hesaplamalar sonucunda rapor alıyor ve rapor sonucunda kırmızı hücrelerin değerlerini sil demem gerekiyor. Ancak gelin görün tüm hücreler renkli olduğu halde hiç bir hücre değerini silemiyorum çünkü hepsinin hücre rengi gerçekte beyaz, görünürde renkli.

 

[kargec]

Sorgu yapmadan herhangi bir hücreyi herhangi bir renk ile dolgu yapın o zaman gerçekten dolgu yapıyor ve sorguda hücre rengi ne ise onu veriyor.

 

[Korhan Ayhan]

Merhaba,

Sizin sorunuz koşullu biçimlendirme renklerinin sorgulanması daha önce forumda bir çok kez sorulmuştu.

Bende bu konunun üzerine eğildim.

Koşullu biçimlendirme ile ilgili detaylı bir çalışma hazırlama planım vardı. İşe koyuldum. Fakat hep problemlerle karşılaştım. Sonunda Microsoft Türkiye'yi aradım ve yaşadığım problemleri dile getirdim. Hatta bunu Microsoft'un dış kaynaklarına iletmelerini ve geliştirmelerini talep ettim.

Bu konuyla ilgili henüz bir gelişme yok. Benim verdiğim sorgudaki gibi sadece hücrenin ekrandaki görsel rengini sorgulayabiliyorsunuz. Aslında sizin istediğinizde bu ama, maalesef bu özelliği fonksiyon içinde kullanamıyoruz. Sadece makro içinde sorgulayabiliyoruz.

Size tavsiyem koşullu biçimlendirme renginden ziyade koşullu biçimlendirmede kullandığınız sorgularınızı dikkate alın.

 

[kargec]

Beni aydınlattığın ve yardımın için teşekkür ederim kardeşim.

İşin ilginç yanı koşullu biçimlendirme yapılmış hücreye "" hücreleri biçimlendir "" dediğinizde bile hücre rengi boş görünüyor, yani renksiz.

Ben çıtır kardeşimden yardım alarak bu işi makro ile çözmeye çalıştım. Ancak kendisi ile anlaşamadım. Sağolsun bana yinede bir makro gönderdi ancak makro hiçbir tepki vermedi.
Bana göndermiş olduğu makro bu:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q4:Q26,L3,K5,M2]) Is Nothing Then Exit Sub
Dim rng As Range
deg1 = Range("L3")
deg2 = Range("K5")
deg3 = Range("M2")
For Each rng In Range("Q4:Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg3 <> 1 And rng > deg1 Or rng < deg2 And rng <> "" Then
rng.Font.ColorIndex = 3
rng.Interior.ColorIndex = 3
End If
If deg3 <> 1 And rng <= deg1 And rng >= deg2 And rng <> "" Then
rng.Font.ColorIndex = 2
rng.Interior.ColorIndex = 4
End If
If deg3 = 1 And rng <> "" Then
rng.Font.ColorIndex = 1
rng.Interior.ColorIndex = 4
End If
Next
End Sub

Bende ısrarla bu makro üzerinde çalıştım, ancak makroyu bölerek tek tek çalıştırabildim.
Makro 1 (L3ten Büyükse)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q4:Q26,L3]) Is Nothing Then Exit Sub
deg1 = Range("L3")
For Each rng In Range("Q4:Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg1 > 1 And rng > deg1 Or rng < deg2 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub

Makro 2 (K5 ten küçükse)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q4:Q26,K5]) Is Nothing Then Exit Sub
deg2 = Range("K5")
For Each rng In Range("Q4:Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg2 < 1 And rng < deg2 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub

Makro 3 (M2ye eşitse)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26,M2]) Is Nothing Then Exit Sub
Dim rng As Range
deg3 = Range("M2")
For Each rng In Range("Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg3 = 1 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub

Ancak 3 makroyu birleştiremedim. Hevesim kırıldı.
Makroları birleştirmek istediğimde ilgili hücrelerin zaten kullanımda olduğu ile ilgili hatalar verdi.
Ama hata verdiği ilgili hücrelerinde kendi ayrı sorguları var.

Şöyleki: M2=1 $L$12,$L$14,$L$16,$L$18,$L$20,$L$22,$L$24,$L$26 Hücreleri otomatik Kırmızı oluyor.

Bir sonraki formülde $L$4:$L$26 > $L$3 ($L$4:$L$26 aralığı L4 teki sayıdan büyük olan değerler kırmızı oluyor. Daha doğrusu olamıyor ilgili hücreler zaten kullanımda diyor.)

Bir sonraki formülde $L$4:$L$26 < $K$5 $L$4:$L$26 aralığı K5 teki sayıdan küçük olan değerler kırmızı oluyor. Daha doğrusu olamıyor ilgili hücreler zaten kullanımda diyor.

İşte böyle kardeşim kaç gündür gece yarılarına kadar buna uğraşıyorum. Ama Excel bilgim çok kısıtlı dolayısı ile beceremedim.

Neyse kafanı şişirdim kardeşim, Hakkını helal et. Kusuruma bakma.
Yardımın için tekrardan teşekkür ederim.
Saygılar...

 

[Korhan Ayhan]

Örnek dosyanızı eklerseniz yardımcı olabilirim.

 

[kargec]

Teşekkürler kardeşim..
Dosyaya çalışma konusunda açıklamaları ekleyip gönderiyorum.

 

[kargec]

Dosya burada kardeşim.
İlgili açıklamaları program altına yazdım.
Kolay gelsin.
http://s7.dosya.tc/server5/4nsyvv/Esat.rar.html

 

[kargec]

Korhan kardeşim 2 makroyu birleştirmeyi başardım
şöyle yaptım çalışmaya başladı..

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26,M2]) Is Nothing Then Exit Sub
Dim rng As Range
deg3 = Range("M2")
For Each rng In Range("Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg3 = 1 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub
Private Sub Worksheet_Change1(ByVal Target As Range)
If Intersect(Target, [Q4:Q26,L3]) Is Nothing Then Exit Sub
deg1 = Range("L3")
For Each rng In Range("Q4:Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg1 > 1 And rng > deg1 Or rng < deg2 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub


ikinci sorgunun sonuna 1 koydum ( Private Sub Worksheet_Change1(ByVal Target As Range)

üçüncü makroyuda aynı yöntemle eklemeye çalışayım.

 

[kargec]

hata veriyor birleştiremedim

 

[Korhan Ayhan]

Bu dosyanızda kodlar ile tam olarak ne yapmak istiyorsunuz?

 

[kargec]

Koşullu biçimlendirmeyi makro ile yapmak istiyorum.

 

[kargec]

veya şu iki makroyu birleştirin işimi görecektir.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26,M2]) Is Nothing Then Exit Sub
Dim rng As Range
deg3 = Range("M2")
For Each rng In Range("Q12,Q14,Q16,Q18,Q20,Q22,Q24,Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg3 = 1 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [Q4:Q26,L3]) Is Nothing Then Exit Sub
deg1 = Range("L3")
For Each rng In Range("Q4:Q26")
rng.Font.ColorIndex = xlNone
rng.Interior.ColorIndex = xlNone
If deg1 > 1 And rng > deg1 Or rng < deg2 And rng <> "" Then
rng.Font.ColorIndex = 3 'Kırmızı
rng.Interior.ColorIndex = 3 'Kırmızı
Else
rng.Font.ColorIndex = 1 'Siyah
rng.Interior.ColorIndex = -4142 'Beyaz
End If
Next
End Sub

 

[Korhan Ayhan]

Koşullarınızı anlatır mısınız?

Neresi ne değerini alınca hangi rengi alacak? Hücre aralıkları belirterek açıklayın lütfen.

 

[kargec]

m2=1 ise q12,q14,q16,q18,q20,q22,q24,q26 taban ve yazı rengi kırmızı

q4:q26 <> L3 ise q4:q26 taban ve yazı rengi kırmızı

Bunlar yeterli