Koşula Göre Biçimlendir

[samet_can]

S.A. ;


Arkadaşlar hücrede örnek başladı yazıyorsa o hücre yanıp sönsün, bunun için arşivi araştırdım. Makrolu olarak çalışma yapılmış. Makrosuz koşullu biçimlendirme modülünden formülle yapabilirmiyiz

Hayırlı sabahlar,

 

[Erdem Akdemir]

Samet bey merhaba,

Makrosuz yapamazsınız.

 

[samet_can]

Samet bey merhaba,

Makrosuz yapamazsınız.

Sayın Kuvari;
Makro olarak, modül açıp içine;
Sub Autpen()
DoEvents
Sheets("Sayfa1").Range("D2").Interior.ColorIndex = 3
Application.OnTime Now + TimeValue("00:00:01"), "Renkli"
End Sub

Sub Renkli()
DoEvents
Sheets("Sayfa1").Range("D2").Interior.ColorIndex = 0
Application.OnTime Now + TimeValue("00:00:01"), "Autpen"
End Sub

Kodu yazdığımda boş alan d2 yanıp sönüyor. diyelim ki hücre boş değilde D : D de hangi hücre içine "BAŞLANDI" yazarsa yanıp sönsün koşulu için nasıl düzenlemem gerekiyor

 

[Ömer]

Merhaba,

Aşağıdaki mantıkla çalıştırabilirsiniz. Yalnız bu tür kodlar sayfa arkasında sürekli çalışacağı için işlerinizi yavaşlatabilir ya da farklı sorunlarla karşılaşabilirsiniz.

Tavsiye etmediğimi bilmenizi isterim. Bunun yerine koşullu biçimlendirme kullanarak yanıp sönme yerine sadece renklendirme en mantıklısıdır.

Dim S1 As Worksheet, a As Byte, c As Range, Adr As String

Sub Auto_Open()
    DoEvents
    a = 3
    Call Bul
    Application.OnTime Now + TimeValue("00:00:01"), "Renkli"
End Sub

Sub Renkli()
    DoEvents
    a = 0
    Call Bul
    Application.OnTime Now + TimeValue("00:00:01"), "Auto_Open"
End Sub

Sub Bul()
    
    Set S1 = Sheets("Sayfa1")
    With S1.Range("D:D")
        Set c = .Find("BAŞLANDI", , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                c.Interior.ColorIndex = a
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With

End Sub

.

 

[samet_can]

Merhaba,

Aşağıdaki mantıkla çalıştırabilirsiniz. Yalnız bu tür kodlar sayfa arkasında sürekli çalışacağı için işlerinizi yavaşlatabilir ya da farklı sorunlarla karşılaşabilirsiniz.

Tavsiye etmediğimi bilmenizi isterim. Bunun yerine koşullu biçimlendirme kullanarak yanıp sönme yerine sadece renklendirme en mantıklısıdır.

Dim S1 As Worksheet, a As Byte, c As Range, Adr As String

Sub Auto_Open()
    DoEvents
    a = 3
    Call Bul
    Application.OnTime Now + TimeValue("00:00:01"), "Renkli"
End Sub

Sub Renkli()
    DoEvents
    a = 0
    Call Bul
    Application.OnTime Now + TimeValue("00:00:01"), "Auto_Open"
End Sub

Sub Bul()
    
    Set S1 = Sheets("Sayfa1")
    With S1.Range("D:D")
        Set c = .Find("BAŞLANDI", , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                c.Interior.ColorIndex = a
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    End With

End Sub

.

Bir bildiğiniz var ki kullanma diyorsunuz napalım kullanmam o zaman, teşekkür ederim öneriniz benim için değerlidir
hayırlı akşamlar