Çoklu renklendirme

[mehmet13]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo ws_exit:
Set rng = Aplication(Source, Me.Range("c:c"))
Set rng = Aplication.Intersect(Target, Me.Range("p"))
If rng Is Nothing Then Exit Sub
With Target
Select Case UCase(.Value)

'Burada "" içindeki rakamlar yerine sözcükler yazılabilir.
' = İşaretinden sonra yer alan sayılar renk indeksidir.
' örnek olarak "C:5" DE 3 YAZDIĞIMIZDA "P:5" TEKİ HÜCRE KIRMIZI YAPMAK İSTİYORUM"

Case Is = "1": .Interior.ColorIndex = 1
Case Is = "2": .Interior.ColorIndex = 2
Case Is = "3": .Interior.ColorIndex = 3
Case Is = "4": .Interior.ColorIndex = 4
Case Is = "5": .Interior.ColorIndex = 5
Case Is = "6": .Interior.ColorIndex = 6
Case Is = "7": .Interior.ColorIndex = 7
Case Is = "8": .Interior.ColorIndex = 6
Case Is = "9": .Interior.ColorIndex = 9
Case Is = "10": .Interior.ColorIndex = 10
Case Is = "11": .Interior.ColorIndex = 11


Case Else
.Interior.ColorIndex = xlNone
End Select
End With

ws_exit:
End Sub

 

[Orion1]

C sütununa sayısal değer giriniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C:C]) Is Nothing Then Exit Sub
On Error Resume Next
Cells(Target.Row, "P").Interior.ColorIndex = 0
Cells(Target.Row, "P").Interior.ColorIndex = Target.Value
End Sub

 

[mehmet13]

Çok Teşekkürler,
Peki burada sayısal değer yerine harf veya kelimelere karşıılık renklendirme istersem.her harfe bir renk vermek gibi mesela .yani bendeki kod yazılışı üzerinden bunu istediğim gibi değiştirebiliyorum.
Bunu bazen harf karekteri bazen de sayılsal olarak kullanacagım bir üretim kapasite hesaplayacağım bir dosyada kullanacağım.
dosyayı da ekledim bi göz atarsan sevinirim.Teşekkürler tekrar.

 

[Korhan Ayhan]

Selamlar,

"Case" ile başlayan satırlarınızı aşağıdaki şekilde değiştirip deneyiniz.

"C" sütununa veri girdikçe "P" sütunu renklenir.

Case Is = "1": .Offset(0, 13).Interior.ColorIndex = 1

 

[mehmet13]

Çok teşekkürler.Mükemmel oldu bu ..

tekrar teşekkür ederim ...