Koşula bağlı yanıp sönen hücre

[uurc1]

bir çalışmada kullanmak üzere "EY94" hücrresndei "EY183:2586" aralığında eşit bir değer var ise yanıp sönmesini istiyorum site içinde araştırmama rağmen bulamadım yardımcı olursanız sevinirim şimdiden teşekkür ederim.
koşullu biçimlendirme gibi çalışacak tek fark ey94 hücresi eşit değer var ise yanıp sönecek

 

[Zeki Gürsoy]

Ekteki dosyayı inceleyin.

http://dosya.co/04vdilds50wu/Yanıp_Sönen_Hücreler.xlsm.html

[SIZE=2]Private r As Range, durdur As Boolean

Sub bitir()
    durdur = True
End Sub

Sub baslat()
    Dim arr() As Range, i As Integer, s As Integer
    
    For i = 183 To 2586
        
        If Cells(i, "ey") = [ey94] Then
            
            s = s + 1
            
            ReDim Preserve arr(1 To s)
            
            Set arr(s) = ThisWorkbook.Sheets(1).Cells(i, "ey")
            
        End If
        
    Next
    
    If UBound(arr) = 0 Then
        MsgBox "Bulunamadı.", vbExclamation
        Exit Sub
    End If
    
    Set r = arr(1)
    
    If UBound(arr) > 1 Then
    
        For i = 2 To UBound(arr)
            Set r = Union(r, arr(i))
        Next
        
    End If
    
    durdur = False
    Call test1
End Sub

Sub test1()
    If durdur = True Then Exit Sub
    
    r.Font.Color = vbRed
    r.Font.Bold = True
    r.Interior.Color = vbYellow
    
    Application.OnTime Now + TimeSerial(0, 0, 1), "test2"
End Sub

Sub test2()
    r.Font.ColorIndex = xlAutomatic
    r.Font.Bold = False
    r.Interior.Color = xlNone
    
    If durdur = True Then Exit Sub
    
    Application.OnTime Now + TimeSerial(0, 0, 1), "test1"
End Sub[/SIZE]