koşullandırma

[Avidus]

koşullandırma ve durum

Merhabalar;

koşullu biçimlendirmede 3 taneden fazla biçimlendirme yapamıyoruz.
az önce sitede şöle bir şey buldum; ama visual'da invalid Me diyor.
Bunun başka bir yolu var mıdır?
Ayrıca ek'te ki dosya da da bi ufak yardım gerekiyor

Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ws_exit:
Set rng = Application.Intersect(Target, Me.Range("C2:AF11"))
If rng Is Nothing Then Exit Sub
With Target
Select Case UCase(.Value)

'Burada "" içindeki rakamlar yerine sözcükler yazılabilir.
' = İşaretinden sonra yer alan sayılar renk indeksidir.

Case Is = "1": .Interior.ColorIndex = 1
Case Is = "2": .Interior.ColorIndex = 2
Case Is = "3": .Interior.ColorIndex = 3
Case Is = "Yİ": .Interior.ColorIndex = 4
Case Is = "5": .Interior.ColorIndex = 5
Case Is = "6": .Interior.ColorIndex = 6
Case Is = "7": .Interior.ColorIndex = 7
Case Is = "8": .Interior.ColorIndex = 6
Case Is = "9": .Interior.ColorIndex = 9
Case Is = "10": .Interior.ColorIndex = 10
Case Is = "11": .Interior.ColorIndex = 11
Case Is = "12": .Interior.ColorIndex = 12
Case Is = "13": .Interior.ColorIndex = 13
Case Is = "14": .Interior.ColorIndex = 14
Case Is = "15": .Interior.ColorIndex = 15
Case Is = "16": .Interior.ColorIndex = 16
Case Is = "17": .Interior.ColorIndex = 17
Case Is = "18": .Interior.ColorIndex = 18
Case Is = "19": .Interior.ColorIndex = 19
Case Is = "20": .Interior.ColorIndex = 20
Case Is = "21": .Interior.ColorIndex = 21
Case Is = "22": .Interior.ColorIndex = 22
Case Is = "23": .Interior.ColorIndex = 23
Case Is = "24": .Interior.ColorIndex = 24
Case Is = "25": .Interior.ColorIndex = 25
Case Is = "26": .Interior.ColorIndex = 26
Case Is = "27": .Interior.ColorIndex = 27
Case Is = "28": .Interior.ColorIndex = 28
Case Is = "29": .Interior.ColorIndex = 29
Case Is = "30": .Interior.ColorIndex = 30
Case Is = "31": .Interior.ColorIndex = 31
Case Is = "32": .Interior.ColorIndex = 32
Case Is = "33": .Interior.ColorIndex = 33
Case Is = "34": .Interior.ColorIndex = 34
Case Is = "35": .Interior.ColorIndex = 35
Case Is = "36": .Interior.ColorIndex = 36
Case Is = "37": .Interior.ColorIndex = 37
Case Is = "38": .Interior.ColorIndex = 38
Case Is = "39": .Interior.ColorIndex = 39
Case Is = "40": .Interior.ColorIndex = 40
Case Is = "41": .Interior.ColorIndex = 41
Case Is = "42": .Interior.ColorIndex = 42
Case Is = "43": .Interior.ColorIndex = 43
Case Is = "44": .Interior.ColorIndex = 44
Case Is = "45": .Interior.ColorIndex = 45
Case Is = "46": .Interior.ColorIndex = 46
Case Is = "47": .Interior.ColorIndex = 47
Case Is = "48": .Interior.ColorIndex = 48
Case Is = "49": .Interior.ColorIndex = 49
Case Is = "50": .Interior.ColorIndex = 50
Case Is = "51": .Interior.ColorIndex = 51
Case Is = "52": .Interior.ColorIndex = 52
Case Is = "53": .Interior.ColorIndex = 53
Case Is = "54": .Interior.ColorIndex = 54
Case Is = "55": .Interior.ColorIndex = 55
Case Is = "56": .Interior.ColorIndex = 56

Case Else
.Interior.ColorIndex = xlNone
End Select
End With

ws_exit:
End Sub

 

[gencoglu27]

koşullandırma istediğin kadar

Merhaba Değerli arkadaşım..
offis 2007 kurarsan , gayet güzel ara yüzü var..ayrıca koşullu formatlama 3 değil ..istediğin kadar...10..20..30 yapabilirsin...

iyi çalişmalar

 

[N.Ziya Hiçdurmaz]

yanıt

Bir module yerleştirip bu kodu kullanabilirsiniz.

Sub renklendir()
For Each alan In Range("a1:k100")
alan.Interior.ColorIndex = 0
If alan = "1" Then alan.Interior.ColorIndex = 3
If alan = "2" Then alan.Interior.ColorIndex = 4
If alan = "3" Then alan.Interior.ColorIndex = 5
If alan = "4" Then alan.Interior.ColorIndex = 6
If alan = "5" Then alan.Interior.ColorIndex = 7
Next
End Sub