Yanıp Sönen Hücre Makrosu

K

kkkazan

Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Arkadaşlar Merhaba,


G2:G65000 arasında bir fomülüm var ve burda ''S2:S65000'' arasındaki tarih bugünden küçükse ''G'' Sutününda ZAMAN DOLDU yazıyor ben bu ZAMAN DOLDU yazan satırların yanıp sönmesini ikaz niteliğinde haber vermesini istiyorum. Kısaca G Sütününda ZAMAN DOLDU görünüyorsa hücre YANIP sönsün. Yardımcı olursanız sevinirim,
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,609
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Daha önce paylaşılan örneklere linklerden erişebilirsiniz.

yanıp sönen hücre...

merhabalar.. bir çok konu var bunun hakkında ama sizlerden ricam örnek... a1 hücresi b1 den küçük ise kırmızı yansın bunun kodunu arıyorumm.. teşekkürler..
www.excel.web.tr www.excel.web.tr

yanıp sönen yazı

Merhaba bir hücreye "BİNGO" yazmaz istiyorum ve yazının yanıp sönmesini istiyorum. nasıl yapabilirim. teşekkürler
www.excel.web.tr www.excel.web.tr

belirli hücrelerin yanıp sönmesi

ekli dosyada zamanı geçti olan hücrelerin yanıp söner şekilde uyarı vermesini istiyorum bu olabilirmi acaba.
www.excel.web.tr www.excel.web.tr

Bir gün öncesinden hücrenin yanıp sönmesi

Arkadaşlar iş yerinde bir tebligat çalışması yapmaya çalışıyorum, personelin eğitime gideceği tarihleri hücrelere giriyorum, bu hücrelerdeki tarihlerde personelin eğitime gideceği tarihten bir gün önce yanıp sönmesini istiyorum. Fakat yapamadım. Her zamanki gibi sitemizden bir kod buldum ama...
www.excel.web.tr www.excel.web.tr

Makro ile Yanıp Sönme Efekti

Excel'de bir buton oluşturdum. Daha sonra oluşturduğum butona aşağıdaki makroyu kaydettim ancak yanıp sönme efekti olmuyor. Yardımcı olabilirmisiniz. Sub CheckRng() If Range("B1") < Date Then If Range("B1").Font.ColorIndex = xlColorIndexAutomatic Then...
www.excel.web.tr www.excel.web.tr
 
K

kkkazan

Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Korhan Bey Merhaba,

Vermiş olduğunuz tüm linklere baktım fakat uyarlayamadım. bu yüzden kendi sorunumu paylaştım.

Aşağıdaki Şekilde,

G2:G65000 arasında bir fomülüm var formülüm S sutununa girilen tarihden uyarlandı. ''S2:S65000'' arasındaki tarih bugünden küçükse ''G'' Sutününda ZAMAN DOLDU yazıyor ben bu ZAMAN DOLDU yazan satırların yanıp sönmesini ikaz niteliğinde haber vermesini istiyorum. Kısaca G Sütününda ZAMAN DOLDU görünüyorsa hücre YANIP sönsün istiyorum.

Yardımlarınız için şimdiden teşekkür ederim.
 
recepkull

recepkull

Katılım
14 Kasım 2017
Mesajlar
618
Excel Vers. ve Dili
2010 Türkçe
Altın Üyelik Bitiş Tarihi
07-01-2024
Sayfanın kod bölümüne kopyalayın
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$G$2" <> Empty Then deneme
End Sub
Makro kodu
Kod: 
Sub deneme()
For k = 1 To 100
If Range("G2").Value = "ZAMAN DOLDU" Then

Cells(2, 7).Interior.ColorIndex = 6
                  basla = Timer
                  bekle = 1
                  While Timer < basla + bekle
                  DoEvents
                  Wend
Cells(2, 7).Interior.ColorIndex = xlNone
                     basla = Timer
                  bekle = 1
                  While Timer < basla + bekle
                  DoEvents
                  Wend
Else
    Range("G2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
                  
Next k

End Sub
Örnek dosyanız

yanipsonme.xlsm dosyasını indir - download

yanipsonme.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle
s2.dosya.tc s2.dosya.tc
 
K

kkkazan

Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
Recep bey ,

Öncelikle çok sağolun emeğinize sağlık,

Vermiş olduğunuz kod sadece G2 için düşünülmüş Ben G sütününda oluşacak tüm ZAMAN DOLDU lar için bu işlemin gerçekleşmesini sağlamak istiyorum tekrar düzenleme yapabilirseniz sevinirim. (Siyah puntolanan alanların tüm G2 den G65000 e kadar düzenlenmesi gerekiyor ve her ZAMAN DOLDU olanları yanıp söner hale getirip ikaz vermesi . yardımlarınız için şimdiden teşekkür ederim.

Sayfanın Kod Bölümü

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$2" <> Empty Then deneme
End Sub


Modül Bölümü

If Range("G2").Value = "ZAMAN DOLDU" Then

Cells(2, 7).Interior.ColorIndex = 6
basla = Timer
bekle = 1
While Timer < basla + bekle
DoEvents
Wend
Cells(2, 7).Interior.ColorIndex = xlNone
basla = Timer
bekle = 1
While Timer < basla + bekle
DoEvents
Wend
Else
Range("G2").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If

Next k

End Sub
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
Merhaba
Denerseniz ekte alternatif dosya bulunuyor
Kodlar "modül"-"Buçalışmakitabı(Thisworkbook)"-"Sayfa1" kod pencerelerindedir
https://www.dosyaupload.com/rVfL
"Modül1"
Kod: 
Private rt As Date
Sub renk()
Set s1 = Sheets("Sayfa1")
x = s1.Cells(Rows.Count, "G").End(3).Row
With s1.Range("G1:G" & x)
    Set c = .Find("ZAMAN DOLDU", LookIn:=xlValues)
    If Not c Is Nothing Then
f = c.Address
  Do
If s1.Range(c.Address).Interior.ColorIndex = 3 Then
s1.Range(c.Address).Interior.ColorIndex = xlNone
Else
s1.Range(c.Address).Interior.ColorIndex = 3
End If
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With
rt = Now + TimeSerial(0, 0, 1)
Application.OnTime rt, "renk", , True

End Sub
Sub DUR()
On Error Resume Next
Application.OnTime rt, "renk", , False
End Sub
"Buçalışmakitabı(thisworkbook)
Kod: 
Private Sub Workbook_Open()
If ActiveSheet.Name = "Sayfa1" Then Call renk
End Sub
"Sayfa1"
Kod: 
Private Sub Worksheet_Activate()
Call renk
End Sub


Private Sub Worksheet_Deactivate()
Call DUR
End Sub
 
Son düzenleme:
K

kkkazan

Katılım
13 Ekim 2016
Mesajlar
30
Excel Vers. ve Dili
Microsoft excel 2010
PLİNT' Alıntı:
Merhaba
Denerseniz ekte alternatif dosya bulunuyor
Kodlar "modül"-"Buçalışmakitabı(Thisworkbook)"-"Sayfa1" kod pencerelerindedir
https://www.dosyaupload.com/rVfL
"Modül1"
Kod: 
Private rt As Date
Sub renk()
Set s1 = Sheets("Sayfa1")
x = s1.Cells(Rows.Count, "G").End(3).Row
With s1.Range("G1:G" & x)
    Set c = .Find("ZAMAN DOLDU", LookIn:=xlValues)
    If Not c Is Nothing Then
f = c.Address
  Do
If s1.Range(c.Address).Interior.ColorIndex = 3 Then
s1.Range(c.Address).Interior.ColorIndex = xlNone
Else
s1.Range(c.Address).Interior.ColorIndex = 3
End If
Set c = .FindNext(c)
If c Is Nothing Then Exit Do
        Loop While Not c Is Nothing And c.Address <> f
    End If
End With
rt = Now + TimeSerial(0, 0, 1)
Application.OnTime rt, "renk", , True

End Sub
Sub DUR()
On Error Resume Next
Application.OnTime rt, "renk", , False
End Sub
"Buçalışmakitabı(thisworkbook)
Kod: 
Private Sub Workbook_Open()
If ActiveSheet.Name = "Sayfa1" Then Call renk
End Sub
"Sayfa1"
Kod: 
Private Sub Worksheet_Activate()
Call renk
End Sub


Private Sub Worksheet_Deactivate()
Call DUR
End Sub
Genişletmek için tıkla ...
Çok Teşekkürler bu işimi çözdü
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst