• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan MESUT K
  • Başlangıç tarihi Başlangıç tarihi
M

MESUT K

Katılım
26 Nisan 2019
Mesajlar
221
Excel Vers. ve Dili
İş'te:Excel 2016 eng
Ev'de:Excel 2013 tr
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
 
Merhaba;
Örnekteki kodları kendi dosyanıza uygulayın.
İyi çalışmalar.
 

Ekli dosyalar

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
 
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 ...
 
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 ...
 
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.
 
Kodun modül üzerine yazılması lazım sanırım
 
Siz örnek dosyanızı paylaşın. Ona göre kodu revize edelim.
 
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

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

İş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
 
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.
Geri
Üst