Soru Makro "kod" Koşula göre hücreyi renklendirme

M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Herkese Selamlar

W8:W17, W24:W39, W46:W53, W60:W69 sütununda evet/hayır koşuluna göre renklenmesini istiyorum
evet yazınca hücre yeşil
hayır yazınca hücre kırmızı olmalı

buna bağlı olarak
W sütunudaki hücreler renklenince AF sütunundakilerde etkilensin

W8:W17----->AF8:AF17
W24:W39----->AF24:AF39
W46:W53----->AF46:AF53
W60:W69----->AF60:AF69

Kod için yardımınızı istiyorum

Saygılarımla
 
muygun

muygun

Özel Üye
Katılım
6 Temmuz 2004
Mesajlar
9,224
Excel Vers. ve Dili
Excel-2003 Türkçe
Merhaba;
Örnekteki kodları kendi dosyanıza uygulayın.
İyi çalışmalar.
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,521
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Alternatif;

C++: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Veri As Range
    Set Alan = Union(Range("W8:W17"), Range("W24:W39"), Range("W46:W53"), Range("W60:W69"))
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        Select Case UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
            Case "EVET"
                Target.Interior.ColorIndex = 43
                Cells(Target.Row, "AF").Interior.ColorIndex = 43
            Case "HAYIR"
                Target.Interior.ColorIndex = 3
                Cells(Target.Row, "AF").Interior.ColorIndex = 3
            Case Else
                Target.Interior.ColorIndex = xlNone
                Cells(Target.Row, "AF").Interior.ColorIndex = xlNone
        End Select
    Else
        For Each Veri In Intersect(Selection, Alan)
            Select Case UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                Case "EVET"
                    Veri.Interior.ColorIndex = 43
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 43
                Case "HAYIR"
                    Veri.Interior.ColorIndex = 3
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 3
                Case Else
                    Veri.Interior.ColorIndex = xlNone
                    Cells(Veri.Row, "AF").Interior.ColorIndex = xlNone
            End Select
        Next
    End If
End Sub
 
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
ALternatif kodda çalışıyor.Çok teşekkürler



Korhan Ayhan' Alıntı:
Alternatif;

C++: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Veri As Range
    Set Alan = Union(Range("W8:W17"), Range("W24:W39"), Range("W46:W53"), Range("W60:W69"))
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        Select Case UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
            Case "EVET"
                Target.Interior.ColorIndex = 43
                Cells(Target.Row, "AF").Interior.ColorIndex = 43
            Case "HAYIR"
                Target.Interior.ColorIndex = 3
                Cells(Target.Row, "AF").Interior.ColorIndex = 3
            Case Else
                Target.Interior.ColorIndex = xlNone
                Cells(Target.Row, "AF").Interior.ColorIndex = xlNone
        End Select
    Else
        For Each Veri In Intersect(Selection, Alan)
            Select Case UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
                Case "EVET"
                    Veri.Interior.ColorIndex = 43
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 43
                Case "HAYIR"
                    Veri.Interior.ColorIndex = 3
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 3
                Case Else
                    Veri.Interior.ColorIndex = xlNone
                    Cells(Veri.Row, "AF").Interior.ColorIndex = xlNone
            End Select
        Next
    End If
End Sub
Genişletmek için tıkla ...
 
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Birşey daha sormak istiyorum.

hücreye "evet" veya "hayır" yazılınca kod çalışıyor.Fakat hücreye formülle "evet" veya "hayır" yazdırınca kod çalışmıyor.

MESUT K' Alıntı:
ALternatif kodda çalışıyor.Çok teşekkürler
Genişletmek için tıkla ...
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,521
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sayfanın "Change" olayı demek bir hücreye veri girip enter ya da tab tuşuna basmış olmak demektir.

Bu sebeple formülle değişen hücreler için farklı kurgu yapmak gerekecektir.
 
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Kodun modül üzerine yazılması lazım sanırım
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,521
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Siz örnek dosyanızı paylaşın. Ona göre kodu revize edelim.
 
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Y sütununa 0 ya da 1 yazınca
W sütununda evet ya da hayır yazıyor

buna bağlı olarak W sütunu renklenince ve AF sütunuda etkilenecek.Dosya ektedir
 

Ekli dosyalar

M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Hücre renklendirmeyi formül içermeyen hücrede çalışması için yukarıda yazılan kodlar işimi görüyor.Fakat formül içeren hücrelerde çalışması için başka kod düzeni gerekli.Bilen arkadaşlardan yardım istiyorum.

W8:W17, W24:W39, W46:W53, W60:W69 sütununda evet/hayır koşuluna göre renklenmesini istiyorum
evet yazınca hücre yeşil
hayır yazınca hücre kırmızı olmalı

buna bağlı olarak
W sütunudaki hücreler renklenince AF sütunundakilerde etkilensin

W8:W17----->AF8:AF17
W24:W39----->AF24:AF39
W46:W53----->AF46:AF53
W60:W69----->AF60:AF69


Y sütununa 0 ya da 1 yazınca
otomatik olarak W sütununda evet ya da hayır yazıyor


Dosya linki: https://dosya.co/qzc7z2o8mvbk/HÜCRE_RENKLENDİRME.xlsx.html
 

Ekli dosyalar

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,521
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İşlemler "V" sütununa göre yapılırsa sorun çözülecektir.

C++: 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Veri As Range
    Set Alan = Union(Range("V8:V17"), Range("V24:V39"), Range("V46:V53"), Range("V60:V69"))
    If Intersect(Target, Alan) Is Nothing Then Exit Sub
    If Target.Cells.Count = 1 Then
        Select Case Target
            Case 1
                Target.Offset(0, 1).Interior.ColorIndex = 43
                Cells(Target.Row, "AF").Interior.ColorIndex = 43
            Case 0
                Target.Offset(0, 1).Interior.ColorIndex = 3
                Cells(Target.Row, "AF").Interior.ColorIndex = 3
            Case Else
                Target.Offset(0, 1).Interior.ColorIndex = xlNone
                Cells(Target.Row, "AF").Interior.ColorIndex = xlNone
        End Select
    Else
        For Each Veri In Intersect(Selection, Alan)
            Select Case Veri.Value
                Case 1
                    Veri.Offset(0, 1).Interior.ColorIndex = 43
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 43
                Case 0
                    Veri.Offset(0, 1).Interior.ColorIndex = 3
                    Cells(Veri.Row, "AF").Interior.ColorIndex = 3
                Case Else
                    Veri.Offset(0, 1).Interior.ColorIndex = xlNone
                    Cells(Veri.Row, "AF").Interior.ColorIndex = xlNone
            End Select
        Next
    End If
End Sub
 
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
Altın Üyelik Bitiş Tarihi
29-04-2025
Koray Bey çok özür diliyorum elinize emeğinize sağlık.Kod çalışıyor fakat amacıma uygun değil.Olayı kısa özetlemek amaçlı v sütununa 0/1 şeklinde uyarlama yaptım.V sütununa girilecek veriler çok faklılık gösterecek 0,1 üzerinde çalışmayacak.O yüzden evet/hayır a uyarlanması gerekli
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst