Takvimi VBA ile renklendirme

Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
Selam
Ekli dosyada bir takvim var.
Cumartesi ve Pazarları sütun olarak renklendirmek istiyorum.
Koşullu biçimlendirme ile yapıyorum ama vba ile daha kolay ve hızlı olacak ve öğrenme açısından da iyi olacak.
ben biraz uğraştım ama tam istediğim gibi olmadı eksik oldu

https://www.dosyaupload.com/27zmw/ÖRNEK_-_TAKVİM.xls

C6:AG6 satırda günler var. (Cumartesi ve Pazar)
Birde o ayın güncel günü yazıyor.
1-Cumartesi ve Pazar günlerine rastlayan hücreler
gün satırı da (6.satır) dahil olmak üzere 15 satıra kadar sütun olarak sarı olsun.
2-Bir de aktif gün de 6-15 satır arası olan sütun yeşil olsun
mesela gün bugün ayın 21 ise takvimde de 21 gün sütunu 6-15 satır arası yeşil olsun.
3-Ayın son günleri 30 veya 31 çekmesi durumlarda o sütun gri olsun.
zaten 7.satırda çekmeyen günler "-" ile belirtiliyor .
Teşekkürler...
 

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
Merhaba,
Dener misiniz?
C++:
Private Sub Worksheet_Calculate()
    Dim My_Area As Range, Rng As Range 
    Set My_Area = Range("C6:AG15")
    My_Area.Interior.ColorIndex = xlNone

For Each Rng In My_Area
    sut = Split(Rng.Address, "$")(1)
    If Rng.Value = "CUMARTESİ" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "CUMARTESİ" Then Rng.Font.ColorIndex = 1
        
    If Rng.Value = "PAZAR" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "PAZAR" Then Rng.Font.ColorIndex = 1
        
    If Range("AK1") = Range("AM1") And Cells(7, sut) = Day(Range("D2")) Then _
        Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 4
        
        
    If Range("AG7") = 31 Then
        Range("AG6:AG15").Interior.ColorIndex = 15
    Else
        Range("AF6:AF15").Interior.ColorIndex = 15
    End If
Next
End Sub
 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
idi)Süpersiniz
mükemmel olmuş
sadece ay sonları yanlış oluyor
Pardon Şubat ayını unutmamak lazım zira o da 28 çekiyor (bu yıl 29 idi)
28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak
Teşekkürler
 
Son düzenleme:

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
sadece ay sonları yanlış oluyor
Pardon Şubat ayını unutmamak lazım zira o da 28 çekiyor (bu yıl 29 idi)
28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak
Haklısınız,
Şubat ayı gözümden kaçmış.
Mevcut kodun


Kod:
If Range("AG7") = 31 Then
        Range("AG6:AG15").Interior.ColorIndex = 15
    Else
        Range("AF6:AF15").Interior.ColorIndex = 15
End If
kısmının yerine aşağıdaki kodu yapıştırarak dener misiniz?
C++:
    For i = 33 To 30 Step -1
        If IsNumeric(Cells(7, i)) Then
            Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
            Exit For
        End If
    Next i
 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
Ben de sizden örnek alarak ay sonunu çözmüştüm. "-" üzerinden yaptım. örnek ekli...
tabii ki sizinki daha daha formüle olmuş hali
Bir de ekleme yaptım
C8:AG15 arasında hücrelerde bulunan sayılaın öne çıkması için mavi olmasını istemiştim ama
6.ve 7, satırlar da tanımlandığı için o satırlar da giriyor. Benim örnekte 3 sayfada koşullu biçimlendirme ile yaptığım şekilde
2. sayfada da vba lie bunu gerçekleştirebilmek.
İlginiz için teşekkürler

 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
For i = 33 To 30 Step -1
If IsNumeric(Cells(7, i)) Then
Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
Exit For
End If
Next i


Bulunduğu ay'ın son gününü de da gri yapıyor
ay 30 çekiyorsa 30 da dahil gri,
31 çekiyorsa 31 da dahil gri,
28 çekiyorsa 289 da dahil son sütunlarda gri oluyor...
 

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
#3 no.lu mesajınızda "...28 veya 30 veya 31 çeken aylar sonrası 1 - 2 veya 3 sütun gri olacak ..." demiştiniz.
Eğer sadece ayın son gününün gri olmasını istiyorsanız, koddaki 33 sayısını i harfi ile değiştirmeniz yeterli olacaktır.
 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
hayır hayır 3 mesajımdaki isteğim geçerlidir.
Zaten ben de son gönderdiğim örnekte 3 sayfada yaptığım gibi olacak
bu şekilde kalabilir.
C8:AG15 arasında hücrelerde bulunan sayıların mavi olması yeterlidir.
Sayenizde çok şey öğrendim eklemeler yapmayı başardım.
sağ olun
var olun...
 

dEdE

Destek Ekibi
Destek Ekibi
Katılım
1 Temmuz 2005
Mesajlar
2,605
Excel Vers. ve Dili
Ofis 2013 TR 64 Bit
C++:
Private Sub Worksheet_Calculate()
    Dim My_Area As Range, Rng As Range
    Set My_Area = Range("C6:AG15")
    My_Area.Interior.ColorIndex = xlNone

For Each Rng In My_Area
    sut = Split(Rng.Address, "$")(1)
    If Rng.Value = "CUMARTESİ" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "CUMARTESİ" Then Rng.Font.ColorIndex = 1
        
    If Rng.Value = "PAZAR" Then Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 6
    If Rng.Value = "PAZAR" Then Rng.Font.ColorIndex = 1
        
    If Range("AK1") = Range("AM1") And Cells(7, sut) = Day(Range("D2")) Then _
        Range(sut & 6 & ":" & sut & 15).Interior.ColorIndex = 4
    
    sat = Split(Rng.Address, "$")(2)
    If sat > 7 And Rng.Value <> "" Then Rng.Interior.ColorIndex = 28
        
    For i = 33 To 30 Step -1
        If IsNumeric(Cells(7, i)) Then
            Range(Cells(6, i).Address, Range(Cells(15, 33).Address)).Interior.ColorIndex = 15
            Exit For
        End If
    Next i
Next
End Sub
 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
çok süper
elinize sağlık
rakamların renklenmesinde 0 'larda da renkleniyor.
Sıfırlarda renklenmese iyi olacak
uğraşıyorum ama çözemedim.
 
Katılım
2 Nisan 2008
Mesajlar
132
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
If sat > 7 And Rng.Value <> 0 Then Rng.Interior.ColorIndex = 28

bu şekilde oldu.
Teşekkürler
 
Üst