Soru Tıklama İle Sütünları Reklendirme

[CEROKS]

Herkese merhabalar.
Resimdeki gibi bir excel dosyam var ve rakamların bulunduğu sütünlara maus ile 1 tıklama ile dolgu renginin değiştirilmesini istiyorum.
Örnek amaçlı olarak;
a1 sütünuna maus ile 1 kere tıkladığımda kırmızı 2. tıkladığımda mavi 3. tıkladığımda yesil ve 4. tıkladığım da siyaha dönmesini istiyorum ve bunu nasıl yapcağımı bilmiyorum.

Bu konuda bana yardımcı olursanız çok mutlu olurum.
Şimdiden teşekkür ederim.

 

[Asri]

Sayfanın kod bölümüne yapıştırın.
Aynı hücre için 4 den büyük tıklama sayısında hücre sıfırlanır ve renkler temizlenir.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Selection.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
   
    If Intersect(Target, Range("A:C")) Is Nothing Then Exit Sub
            If Cells(Target.Row, Target.Column + 100).Value = 0 Then
               Cells(Target.Row, Target.Column + 100).Value = 1
            Else
               Cells(Target.Row, Target.Column + 100).Value = Cells(Target.Row, Target.Column + 100).Value + 1 
            End If
           
            If Cells(Target.Row, Target.Column + 100).Value = 1 Then
               Cells(Target.Row, Target.Column).Interior.Color = 255
            End If
           
            If Cells(Target.Row, Target.Column + 100).Value = 2 Then
                Cells(Target.Row, Target.Column).Interior.Color = 15773696
            End If
           
            If Cells(Target.Row, Target.Column + 100).Value = 3 Then
                 Cells(Target.Row, Target.Column).Interior.Color = 5296274
            End If
           
            If Cells(Target.Row, Target.Column + 100).Value = 4 Then
                 Cells(Target.Row, Target.Column).Interior.Color = 0
            End If
           
            If Cells(Target.Row, Target.Column + 100).Value > 4 Then
                    Cells(Target.Row, Target.Column + 100).Value = 0
                 Cells(Target.Row, Target.Column).Interior.Pattern = xlNone
            End If
           Cells(Target.Row, "D").Select
End Sub