56 Koşula Kadar Biçimlendirme Yapma

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ws_exit:
\'Buradan koşullu biçimlendirme yapacağımız aralığı verebiliriz
Set rng = Application.Intersect(Target, Me.Range("A:z"))
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 = "4": .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

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 And Target.Value >= 1 And Target.Value <= 56 Then Target.Interior.ColorIndex = Target.Value
End Sub