• DİKKAT

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

Birden Fazla koşul

Mdemir63

Altın Üye
Katılım
7 Temmuz 2006
Mesajlar
2,989
Excel Vers. ve Dili
Ofis2010 32Bit Türkçe
Selamlar,
Arkadaşlar ekteki dosyamda belirttiğim üzere dosyam düzgün çalışıyor ama bir tek eksiklik var o da harfi sildiğimde eski haline dönmüyor. Kodlarda nasıl bir değişiklik yapmalıyım?

Saygılar
 
Kodlarınız aşağıdaki gibi olmalı.


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
satirlar = "B" & Target.Row & ":G" & Target.Row
Select Case Target
Case "E", "e": Range(satirlar).Interior.ColorIndex = 37
Case "K", "k": Range(satirlar).Interior.ColorIndex = 38
Case "A", "a": Range(satirlar).Interior.ColorIndex = 12
Case "İ", "i": Range(satirlar).Interior.ColorIndex = 48

Case Else
Range(satirlar).Interior.ColorIndex = xlNone

End Select

End Sub


.
 
Kodlarınıza aşağıdaki kodlarda kırmızı ile yazılan kodu ekleyiniz.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
satirlar = "B" & Target.Row & ":G" & Target.Row
Select Case Target
Case "E", "e": Range(satirlar).Interior.ColorIndex = 37
Case "K", "k": Range(satirlar).Interior.ColorIndex = 38
Case "A", "a": Range(satirlar).Interior.ColorIndex = 12
Case "İ", "i": Range(satirlar).Interior.ColorIndex = 48
[COLOR="Red"]Case "": Range(satirlar).Interior.ColorIndex = xlNone[/COLOR]
End Select
End Sub
 
Şöyle deneyin.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G:G]) Is Nothing Then Exit Sub
satirlar = "B" & Target.Row & ":G" & Target.Row
Select Case Target
Case "": Range(satirlar).Interior.ColorIndex = xlNone
Case "E", "e": Range(satirlar).Interior.ColorIndex = 37
Case "K", "k": Range(satirlar).Interior.ColorIndex = 38
Case "A", "a": Range(satirlar).Interior.ColorIndex = 12
Case "İ", "i": Range(satirlar).Interior.ColorIndex = 48
End Select
End Sub
 
Yurttaş hocam
Orion2 hocam

İlginize çok teşekkürler sağolun

Saygılar
 
Sayfayı açıp cevap gönderene kadar, dün Necdet beyin dediği gibi iş bitmiş teşekkürler edilmiş oluyor.
Grevle ilgisi yok diye düşünüyorum. Çünkü 1 haftadan fazla süresir internet acaip yavaş. Yetersiz altyapı ile herhalde bu kadar oluyor.
 
AS3434 hocam sizede ayrıca teşekkür ederim.
Saygılar
 
Arkadaşlar bu konuyla ilgili birşey sorucam. Sayfayı koruma altına aldığımızda bu renklendirme makrosu çalışmıyor. Bunu nasıl çalışır hale getirebiliriz.
 
Arkadaşlar bu konuyla ilgili birşey sorucam. Sayfayı koruma altına aldığımızda bu renklendirme makrosu çalışmıyor. Bunu nasıl çalışır hale getirebiliriz.

Kodların başına aşağıdaki kodları yazınız.:cool:
Kod:
Sheets("Sayfa1").unprotect
kodların sonuna
Kod:
sheets("Sayfa1").protect
Sayfa adını sizin sayfa adıyla değiştiriniz.:cool:
 
Geri
Üst