Makro ile Renklendirme

[bekir38]

Merhaba arkadaşlar,
sitede baya bi aradım ama istediğim gibi birşey bulamadım,

ekteki örnekte olduğu gibi a1 ile ı3 hücreleri arasında 1 den 50 ye kadar sayılarım var. bunların her seferinde yerleri değişmekte,

şöyle birşey yapabilirmiyiz,
1 den 9 a kadar olan sarı,
10 dan 19 a kadar olan kırmızı,
20 den 29 a kadar olan mavi,
30 dan 39 a kadar olan turuncu,

gibi olsun istiyorum, böyle birşey olabilir mi?

yardımlarınızı bekliyorum,

 

[Recep İpek]

Aşağıdaki kodları sayfanın VBE sayfasına kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a1:I3]) Is Nothing Then Exit Sub
For Each alan In [a1:I3]
Select Case alan.Value
Case 1 To 9
alan.Font.ColorIndex = 36
Case 10 To 19
alan.Font.ColorIndex = 3
Case 20 To 29
alan.Font.ColorIndex = 5
Case 30 To 39
alan.Font.ColorIndex = 45
Case 40 To 49
alan.Font.ColorIndex = 7
End Select
Next
End Sub

 

[N.Ziya Hiçdurmaz]

yanıt

Boşa gitmesin.

Private Sub Worksheet_Change(ByVal Target As Range)
For Each ren In Range("a1:I3")
ren.Interior.ColorIndex = 0
If ren > 0 And ren < 11 Then
ren.Interior.ColorIndex = 36
End If
If ren > 10 And ren < 21 Then
ren.Interior.ColorIndex = 3
End If
If ren > 20 And ren < 31 Then
ren.Interior.ColorIndex = 5
End If
If ren > 30 And ren < 41 Then
ren.Interior.ColorIndex = 45
End If
Next
End Sub

 

[Necdet]

Gerçekten boşa gitmesin

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Select Case Target.Value
    Case Is < 10
        Target.Interior.ColorIndex = 6
    Case Is < 20
        Target.Interior.ColorIndex = 3
    Case Is < 30
        Target.Interior.ColorIndex = 5
    Case Is < 40
        Target.Interior.ColorIndex = 45
    Case Is < 50
        Target.Interior.ColorIndex = 31
End Select
End Sub

 

[İdris SERDAR]

Merhaba arkadaşlar,
sitede baya bi aradım ama istediğim gibi birşey bulamadım,

ekteki örnekte olduğu gibi a1 ile ı3 hücreleri arasında 1 den 50 ye kadar sayılarım var. bunların her seferinde yerleri değişmekte,

şöyle birşey yapabilirmiyiz,
1 den 9 a kadar olan sarı,
10 dan 19 a kadar olan kırmızı,
20 den 29 a kadar olan mavi,
30 dan 39 a kadar olan turuncu,

gibi olsun istiyorum, böyle birşey olabilir mi?
yardımlarınızı bekliyorum,

Ekteki dosyayı inceleyin.

..

 

[bekir38]

Ekteki dosyayı inceleyin.

..

ilgi ve yardımlarınıza çok çok teşekkürler arkadaşlar,

gerçekten çok hızlı ve bol miktarda çözüm oldu,
paylaşma ve yardımlaşmanın gücü bu olsa gerek,

bilgi ve tecrübelerini paylaşan herkeze,
tekrar tekrar teşekkürler,

 

[bekir38]

arkadaşlar sorun çözüldü aslında ama yeni birşey istediler yapamadım,

1 den 9 a kadar olan sarı,
10 dan 19 a kadar olan kırmızı,
20 den 29 a kadar olan mavi,
30 dan 39 a kadar olan turuncu,

bu şekilde renklendirme oldu gayetde güzel çalışıyor, fakat bu hata gruplarından kaç tane var onu otomatik bulabilirmiyim?
en büyüğünü veya en küçüğünü bulabiliyorum ama,

kaç sarı hücre, 1 hata grubu
kaç kırmızı hücre 2 hata grubu gibi olsun istiyorum,

yapılabiliyorsa destek ve yardımlarınızı bekliyorum,

şimdiden teşekkürler,

 

[Recep İpek]

Kodları aşağıdaki şekilde değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a1:I3]) Is Nothing Then Exit Sub
a1 = 0: a2 = 0: a3 = 0: a4 = 0: a5 = 0
For Each alan In [a1:I3]
Select Case alan.Value
Case 1 To 9
alan.Font.ColorIndex = 36
a1 = a1 + 1
Case 10 To 19
alan.Font.ColorIndex = 3
a2 = a2 + 1
Case 20 To 29
alan.Font.ColorIndex = 5
a3 = a3 + 1
Case 30 To 39
alan.Font.ColorIndex = 45
a4 = a4 + 1
Case 40 To 49
alan.Font.ColorIndex = 7
a5 = a5 + 1
End Select
Next
[L2] = a1
[L3] = a2
[L4] = a3
[L5] = a4
[L6] = a5
End Sub

 

[bekir38]

Kodları aşağıdaki şekilde değiştiriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a1:I3]) Is Nothing Then Exit Sub
a1 = 0: a2 = 0: a3 = 0: a4 = 0: a5 = 0
For Each alan In [a1:I3]
Select Case alan.Value
Case 1 To 9
alan.Font.ColorIndex = 36
a1 = a1 + 1
Case 10 To 19
alan.Font.ColorIndex = 3
a2 = a2 + 1
Case 20 To 29
alan.Font.ColorIndex = 5
a3 = a3 + 1
Case 30 To 39
alan.Font.ColorIndex = 45
a4 = a4 + 1
Case 40 To 49
alan.Font.ColorIndex = 7
a5 = a5 + 1
End Select
Next
[L2] = a1
[L3] = a2
[L4] = a3
[L5] = a4
[L6] = a5
End Sub

çok teşekkürler sn. ripek