Vba ile koşul aralığı renklendirme

[bkk]

Merhabalar,

Ekte bulunan çalışma kitabında iki koşul aralığının renklenmesini istiyorum. Açıklamaya çalışacağım, ne kadar mantık çerçevesinde bir şey istiyorum bilmiyorum bunun için kusura bakmayın;
-B2 hücresine değer verdiğimde renklendirme sağlıyor ama istediğim bu değil,
Her hücreyi kontrol etmesini istiyorum, bulduğu ilk x değerinde renklenmeye başlayıp, ikinci bulduğu x değerinde son kez renklenip,
o noktadan tekrar x'i aramalı bu defa bulduğu noktadan tekrar renklendirmeli ve yine bulduğu x değerinde renklendirmeyi son kez yapıp sütun sonuna kadar döngüyü tekrarlamalı,

Şimdiden teşekkürler,

 

[Muzaffer Ali]

Merhaba.

Sayfanın kod kısmına kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BulIlk As Range
    Dim BulSon As Range
    Dim SonSatir As Long
    Dim Bak As Long
    If Not Intersect(Target, Range("B2")) Is Nothing Then
        SonSatir = Cells(Rows.Count, "B").End(xlUp).Row
        Set BulIlk = Target
        For Bak = 1 To SonSatir
            Set BulSon = Range(BulIlk.Offset(1, 0).Address & ":B" & SonSatir).Find(what:=Target, after:=BulIlk.Offset(1, 0), lookat:=xlWhole)
            If BulIlk Is Nothing Or BulSon Is Nothing Then Exit For
            Range(BulIlk.Address & ":" & BulSon.Address).Interior.Color = 65535
            Set BulIlk = Range(BulIlk.Offset(1, 0).Address & ":B" & SonSatir).Find(what:=Target, after:=BulSon.Offset(1, 0), lookat:=xlWhole)
        Next
    End If
End Sub

 

[bkk]

Teşekkür ederim

 

[bkk]

Merhabalar, yazdığınız kodu uyguladım ancak talep ettiğim sonucu alamadım, ekrandaki gibi çıktı veriyor,
Yardımcı olabilir misiniz,

 

[Muzaffer Ali]

Sayfanın kod kısmındaki kodu silin aşağıdakileri kopyalayın.
Butona bastığınızda kodlar çalışır.

Private Sub COMMANDBUTTON1_Click()
    Dim Bak As Range
    Dim RenkSari As Boolean
    For Each Bak In Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
        If RenkSari Then
            Bak.Interior.Color = 65535
        Else
            Bak.Interior.ThemeColor = xlThemeColorDark1
        End If
        If Bak = "x" Then
            RenkSari = Not RenkSari
            Bak.Interior.Color = 65535
        End If
    Next
End Sub