Excel VBA Renk değiştirme makrosu

[metalog]

Merhaba Arkadaşlar,

Öncelikli konuyu yazmadan önce baya bir araştırma yaptım ama tam olarak istediğim gibi bir şey bulamadım.

Aşağıda özet olarak eklediğim dosyada her renk farklı bir durumu simgeliyor ve her rengin işlevi farklı. Ben sadece sarı olan renklerin o gün geldikçe yeşile dönmesini istiyorum. Mesela bugün 15.08.2019 tarihi geldiğinde Ağustos satırı altında 15 yazan hücrelerden sarı renkli olanlar yeşile dönsün ve o şekilde sabit kalsın istiyorum.

Benzer konular var ancak onlar koşullu biçimlendirme ile renksiz hücreleri renklendirme ya da günü gelince hücre renklendirme tarzı şeyler. Benim istediğim direk makro ile halletmek ve sadece sarı renkli hücreleri tek tek uğraşmadan renklendirmek. Sarı renkler planlanan, yeşiller gerçekleşen gibi düşünebiliriz.

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

 

[YUSUF44]

Aşağıdaki kodu ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) kopyalayın. Sayfayı her açtığınızda istediğiniz işlemi yapar:

Private Sub Worksheet_Activate()
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(1, i) = Date Then
        son = Cells(Rows.Count, i).End(3).Row
        For j = 4 To son Step 2
            If Cells(j, i).Interior.Color = vbYellow Then
                Cells(j, i).Interior.Color = vbGreen
            End If
        Next
    End If
Next
End Sub

 

[metalog]

Aşağıdaki kodu ilgili sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) kopyalayın. Sayfayı her açtığınızda istediğiniz işlemi yapar:

Private Sub Worksheet_Activate()
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(1, i) = Date Then
        son = Cells(Rows.Count, i).End(3).Row
        For j = 4 To son Step 2
            If Cells(j, i).Interior.Color = vbYellow Then
                Cells(j, i).Interior.Color = vbGreen
            End If
        Next
    End If
Next
End Sub

Yusuf Bey,

Öncelikle teşekkür ederim göndermiş olduğunuz kod bir iki düzeltmeyle tam istediğim gibi oldu.
Ama yeni renklendirmelerde otomatik olarak makroyu görmüyor. Dosyayı kapatıp açıyorum yine kod işlemiyor yeni renklendirmelere.
Ancak VBA'dan "run sub" yapınca çalışıyor.

Bunu bugünden önceki tarihlerdeki herhangi bir hücreyi sarı yaptığımızda otomatik olarak yeşile çevirecek şekilde düzeltebilir miyiz?

 

[YUSUF44]

Önceki mesajımda da belirttiğim gibi kodun çalışması için "sayfayı açmanız" gerekmektedir. Dosyada başka sayfaya geçip tekrar asıl sayfaya döndüğünüzde kod çalışır.

Her açılışta eski tarihler de kontrol edilsin istiyorsanız

If Cells(1, i) = Date Then

yerine

If Cells(1, i) <= Date Then

kullanmayı deneyin.

Sayfada herhangi bir değişiklik (veri girişi gibi) yaptığınızda çalışması için aşağıdaki kodu kullanabilirsiniz (sayfada renk değiştirme bu kodu aktifleştirmiyor maalesef):

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(1, i) <= Date Then
        son = Cells(Rows.Count, i).End(3).Row
        For j = 4 To son Step 2
            If Cells(j, i).Interior.Color = vbYellow Then
                Cells(j, i).Interior.Color = vbGreen
            End If
        Next
    End If
Next
End Sub

Dosya ilk açıldığında belirttiğiniz kontrolün yapılması için ise aşağıdaki kodları VBA sayfasında ThisWorkBook/BuÇalışmaKitabı kısmına yapıştırın:

Private Sub Workbook_Open()
With Sheets("Sayfa1")
    For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Cells(1, i) <= Date Then
            son = Cells(Rows.Count, i).End(3).Row
            For j = 4 To son Step 2
                If Cells(j, i).Interior.Color = vbYellow Then
                    Cells(j, i).Interior.Color = vbGreen
                End If
            Next
        End If
    Next
End With
End Sub

 

[metalog]

Önceki mesajımda da belirttiğim gibi kodun çalışması için "sayfayı açmanız" gerekmektedir. Dosyada başka sayfaya geçip tekrar asıl sayfaya döndüğünüzde kod çalışır.

Her açılışta eski tarihler de kontrol edilsin istiyorsanız

If Cells(1, i) = Date Then

yerine

If Cells(1, i) <= Date Then

kullanmayı deneyin.

Sayfada herhangi bir değişiklik (veri girişi gibi) yaptığınızda çalışması için aşağıdaki kodu kullanabilirsiniz (sayfada renk değiştirme bu kodu aktifleştirmiyor maalesef):

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(1, i) <= Date Then
        son = Cells(Rows.Count, i).End(3).Row
        For j = 4 To son Step 2
            If Cells(j, i).Interior.Color = vbYellow Then
                Cells(j, i).Interior.Color = vbGreen
            End If
        Next
    End If
Next
End Sub

Dosya ilk açıldığında belirttiğiniz kontrolün yapılması için ise aşağıdaki kodları VBA sayfasında ThisWorkBook/BuÇalışmaKitabı kısmına yapıştırın:

Private Sub Workbook_Open()
With Sheets("Sayfa1")
    For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
        If Cells(1, i) <= Date Then
            son = Cells(Rows.Count, i).End(3).Row
            For j = 4 To son Step 2
                If Cells(j, i).Interior.Color = vbYellow Then
                    Cells(j, i).Interior.Color = vbGreen
                End If
            Next
        End If
    Next
End With
End Sub

Elinize sağlık en son vermiş olduğunuz kod ile halloldu diyebilirim.

Peki bu son kodu tüm sayfalar için nasıl aktif edebiliriz? Mesela ben "Sayfa1" yerine ilk sekme adını yani "2019" yazınca kod çalışıyor. Aynı zamanda 2. sayfa ve 3. sayfa için mesela sayfa adları 2020 ve 2021 diyelim. Hepsi için çalışsın diye

With Sheets("2019";"2020";"2021")

şeklinde yazınca işlemiyor. Bunu nasıl düzenleyebiliriz?

 

[YUSUF44]

Eğer kod dosyada mevcut tüm sayfalarda çalışacaksa aşağıdaki kodu deneyin:

Private Sub Workbook_Open()
For i = 1 To Sheets.Count
    With Sheets(i)
        For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
            If Cells(1, i) <= Date Then
                son = Cells(Rows.Count, i).End(3).Row
                For j = 4 To son Step 2
                    If Cells(j, i).Interior.Color = vbYellow Then
                        Cells(j, i).Interior.Color = vbGreen
                    End If
                Next
            End If
        Next
    End With
Next
End Sub

Eğer sadece belirli sayfalarda çalışacaksa aşağıdaki gibi deneyin. Sayfa adlarının olduğu kısmı "or" ile kendinize göre güncelleyin:

Private Sub Workbook_Open()
For i = 1 To Sheets.Count
    If Sheets(i).Name = "2019" Or Sheets(i).Name = "2020" Or Sheets(i).Name = "2021" Then
        With Sheets(i)
            For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                If Cells(1, i) <= Date Then
                    son = Cells(Rows.Count, i).End(3).Row
                    For j = 4 To son Step 2
                        If Cells(j, i).Interior.Color = vbYellow Then
                            Cells(j, i).Interior.Color = vbGreen
                        End If
                    Next
                End If
            Next
        End With
    End If
Next
End Sub

 

[metalog]

Eğer kod dosyada mevcut tüm sayfalarda çalışacaksa aşağıdaki kodu deneyin:

Private Sub Workbook_Open()
For i = 1 To Sheets.Count
    With Sheets(i)
        For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
            If Cells(1, i) <= Date Then
                son = Cells(Rows.Count, i).End(3).Row
                For j = 4 To son Step 2
                    If Cells(j, i).Interior.Color = vbYellow Then
                        Cells(j, i).Interior.Color = vbGreen
                    End If
                Next
            End If
        Next
    End With
Next
End Sub

Eğer sadece belirli sayfalarda çalışacaksa aşağıdaki gibi deneyin. Sayfa adlarının olduğu kısmı "or" ile kendinize göre güncelleyin:

Private Sub Workbook_Open()
For i = 1 To Sheets.Count
    If Sheets(i).Name = "2019" Or Sheets(i).Name = "2020" Or Sheets(i).Name = "2021" Then
        With Sheets(i)
            For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                If Cells(1, i) <= Date Then
                    son = Cells(Rows.Count, i).End(3).Row
                    For j = 4 To son Step 2
                        If Cells(j, i).Interior.Color = vbYellow Then
                            Cells(j, i).Interior.Color = vbGreen
                        End If
                    Next
                End If
            Next
        End With
    End If
Next
End Sub

Kodlar hata veriyor kontrol edebilir misiniz?

"For i = 2 To....." satırı için şu şekilde bir hata alıyorum:

 

[YUSUF44]

i değişkeni iki kere kullanıldığı için olmuş, benim dikkatsizliğim, kusura bakmayın:

Dosyanın ilk açılışında belirli sayfalarda çalışması için:

Private Sub Workbook_Open()
For k = 1 To Sheets.Count
    If Sheets(k).Name = "2019" Or Sheets(k).Name = "2020" Or Sheets(k).Name = "2021" Then
        With Sheets(k)
            For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                If Cells(1, i) <= Date Then
                    son = Cells(Rows.Count, i).End(3).Row
                    For j = 4 To son Step 2
                        If Cells(j, i).Interior.Color = vbYellow Then
                            Cells(j, i).Interior.Color = vbGreen
                        End If
                    Next
                End If
            Next
        End With
    End If
Next
End Sub

Dosyanın açılışında tüm sayfalarda çalışması için:

Private Sub Workbook_Open()
For k = 1 To Sheets.Count
    With Sheets(k)
        For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
            If Cells(1, i) <= Date Then
                son = Cells(Rows.Count, i).End(3).Row
                For j = 4 To son Step 2
                    If Cells(j, i).Interior.Color = vbYellow Then
                        Cells(j, i).Interior.Color = vbGreen
                    End If
                Next
            End If
        Next
    End With
Next
End Sub

 

[metalog]

Çok teşekkür ederim Yusuf Bey. Çok yardımcı oldunuz.

Konuyu sonlandırmadan makrolar-kodlar kısaca vba konusunda her ne kadar biraz geç kalsam da kendimi geliştirmeye çalışıyorum sürekli, bu yolda sizin kadar olmasa da kendimi geliştirebileceğim bilgi edinebileceğim yol/yöntem/kaynak tavsiyeniz varsa almak isterim. (Udemy videoları mevcut, sitede de bol bol gezinip uygulama yapıyorum. Bunlar dışında olursa sevinirim)

 

[YUSUF44]

Estağfurullah. Benim bilgim nerdeyse yok düzeyinde. Bildiğimin çoğunu da burdan öğrendim. Sorunlara çözüm ararken google amcaya başvurdum vs. Sizle ilgili olsun olmasın sorulan sorulara çözüm bulmaya çalışarak kendinizi geliştirebilirsiniz, benim yöntemim bu.

İyi çalışmalar.