Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Beyin Fırtınası (http://www.excel.web.tr/forumdisplay.php?f=142)
-   -   Girilen sayısal değere göre hücre renklendirme (http://www.excel.web.tr/showthread.php?t=32274)

Korhan Ayhan 22-05-2007 13:43

Girilen sayısal değere göre hücre renklendirme
 
1 Eklenti(ler)
Selamlar,

Arkadaşlar ekteki dosyada [A:E] sütun aralığına girilecek sayısal değerlere göre hücreleri nasıl renklendirebiliriz. Tabi renklendirme şartlı olacak. Girilen sayısal değerler sıralamaya göre renklendirilecektir.

Soruyu çözecek arkadaşlarımızın formül ve makro kodlarının açıklamalarını yazarak yorumda bulunmaları yeni başlayan arkadaşlarımız için faydalı olacaktır.

Not: Başlangıç aşamasında olan arkadaşlarımızda lütfen yorumlarını belirtsinler.

Kolay gelsin.

enderturk 22-05-2007 14:07

re
 
aşağıdaki örnekte her hücre değişiminde hücre değerini a1'den e1'e kadar karşılaştırıp eşleşme durumunda 1.satırdaki uygun renk hücre rengi olarak atanmaktadır.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Value = Range("a1").Value Then Target.Interior.ColorIndex = Range("a1").Interior.ColorIndex
If Target.Value = Range("b1").Value Then Target.Interior.ColorIndex = Range("b1").Interior.ColorIndex
If Target.Value = Range("c1").Value Then Target.Interior.ColorIndex = Range("c1").Interior.ColorIndex
If Target.Value = Range("d1").Value Then Target.Interior.ColorIndex = Range("d1").Interior.ColorIndex
If Target.Value = Range("e1").Value Then Target.Interior.ColorIndex = Range("e1").Interior.ColorIndex

end sub

xxcell 22-05-2007 14:14

Private Sub Worksheet_Change(ByVal Target As Range)

If IsNumeric(Target.Value) And _
Not Intersect(Target, Columns("A:E")) Is Nothing Then _
Target.Interior.ColorIndex = _
Cells(((Target.Value - 1) Mod 5) + 1, "h").Interior.ColorIndex


End Sub



' Girilen değer sayıysa ve A:E aralığında ise
' Color indexini h sütunundaki ilk 5 hücreye göre
' mod 5 yaparak eşitle


Bundan fazla kısaltamadım :mrgreen:

xxcell 22-05-2007 14:25

Verdiğim örnek negatif değerlerde hata verdiği için
şu şekilde modifiye ettim.

Kod:

If IsNumeric(Target.Value) And _
Not Intersect(Target, Columns("A:E")) Is Nothing Then _
Target.Interior.ColorIndex = _
Cells(((IIf(Target.Value < 0, -1, 1) * Target.Value - 1) Mod 5) + 1, "h").Interior.ColorIndex


Levent Menteşoğlu 22-05-2007 14:43

Aşağıdaki kodu sayfanın kod sayfasına kopyalamalıyız. Sorulan soruda en fazla 5 renk için sınırlama yapıldığından bende buna uydum, yani beş renkten fazla ise fazla olan sayı için renklendirme yapılmayacaktır. Kod her yeni veri girildiğinde tüm renklendirmeyi tekrardan yapar.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim sayi As Range
If Intersect(Target, [a:e]) Is Nothing Then Exit Sub
For Each sayi In [a:e].SpecialCells(xlCellTypeConstants, 1)
deg = WorksheetFunction.Rank(sayi, [a:e], 1)
sayi.Interior.ColorIndex = Cells(deg, "h").Interior.ColorIndex
Next
End Sub
 
1-Hata durumunda kodun çalışmaya devam etmesini sağlar.
2-sayi değişkenini range yani aralık olarak tanımlar
3-kodun A:E aralığında çalışması sağlanır.
4-A-E aralığındaki sadece sayısal hücreler için döngü oluşturur.
5-deg değişkenine hücredeki sayının A:E aralığındaki sıra değerini hesaplar
6-Tüm hücreleri sırasına göre renklendirir.
7-döngü bitimi


İdris SERDAR 22-05-2007 15:07

Sayın leventm müsaade ederlerse,

Hücredeki değeri sildiğimizde beyaz olması amacıyla,

koda;

sayi.Interior.ColorIndex = Cells(deg, "h").Interior.ColorIndex

kodlarından sonra gelmek üzere;

If Intersect(Target, [a:e]) = "" Then Intersect(Target, [a:e]).Interior.ColorIndex = xlNone

kodlarını eklersek iyi olur kanısındayım.

..

Levent Menteşoğlu 22-05-2007 15:22

Sn yurttas rica ederim, ilaveniz kodun eksikliğini gidermiştir.

Korhan Ayhan 22-05-2007 15:41

Selamlar,

Arkadaşlar sanırım sorum yanlış anlaşıldı. Sn. leventm beyin çözümüne yakın bir çözüm olacak fakat renklendirme satır bazında sabit kalacak. Yani bir satıra 5 adet değer girdik bu değerler kendi aralarında büyükten küçüğe renklendirilecek. Sayfada verdiğim renklendirmeler örnektir. Yani H sütununun olmadığını düşünerek yanıtlamanızı rica edeceğim.

1. satır için örneklersek;

Girilen değerler;

A1=25 (Kırmızı)
B1=23 (Pembe)
C1=18 (Sarı)
D1=15 (Lacivert)
E1=10 (Yeşil)

Levent Menteşoğlu 22-05-2007 15:56

Bu durumda kodu aşağıdaki gibi düzenleyebiliriz. Bu sefer kod satır bazında düzenlenmiştir. Yani A:E sütununun tümü değil sadece veri girilen satır kendi arasında sıralanmıştır. Yukarıdaki koda tek ilave Sn yurttas'ın hatırlattığı gibi veri silindiğinde hücre renginin kaldırılması ile ilgili satırdır.

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim sayi As Range
If Intersect(Target, [a:e]) Is Nothing Then Exit Sub
satir = Target.Row
For Each sayi In Range("a" & satir & ":e" & satir).SpecialCells(xlCellTypeConstants, 1)
deg = WorksheetFunction.Rank(sayi, Range("a" & satir & ":e" & satir), 1)
sayi.Interior.ColorIndex = Cells(deg, "h").Interior.ColorIndex
If Target = "" Then Target.Interior.ColorIndex = xlNone
Next
End Sub


Ali 22-05-2007 16:12

İki veri aynı olunca renk atlıyor sanırım 10 10 9 8 7 gibi olduğu durumda.

=TOPLA.ÇARPIM((A2<$A$2:$E$2)/EĞERSAY($A$2:$E$2;$A$2:$E$2&""))+1

formülü gibi sıra iki büyüğede 1 değeri verse iyi olur sanırım


Saat 09:46

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.