Renkleri harflere göre Kullanmak.

[usta07]

Bu konu başlığı altında çok soru ve cevap oluşmuş hepsini inceledim kendime uygun bir çözüm üretemedim.
Belirli Bir satırda örneğin a14:af14 arasında 5 ayrı koşul oluşmaktadır. A B C D E Koşullar örneğin b14 hücresi ="A" b10,b11,b12,b13 hücreleride Interior.ColorIndex = 19 gibi, "B" ise = 27 "C" ise = 7 "D" ise = 17 "E" ise = 35 olması gerekiyor "aynı sutunda bulunun 4 satırın da aynı renk olması"
kısacası kod konusunda yardımcı olacak arkadaşların yardımına ihtiyacım var, aşağıdaki kodlar sayın Yurttaş tarafından yazılmış fakat istediğim şekle uyarlayamadım. ilgilerinize teşekkürler.

Option Explicit
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 = Application.Intersect(Target, Me.Range("b14:af14"))
If rng Is Nothing Then Exit Sub
With Target
Select Case UCase(.Value)

Case Is = "A": .Interior.ColorIndex = 19
Case Is = "B": .Interior.ColorIndex = 27
Case Is = "C": .Interior.ColorIndex = 7
Case Is = "D": .Interior.ColorIndex = 17
Case Is = "E": .Interior.ColorIndex = 35

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

ws_exit:
End Sub

 

[usta07]

Muhtemelen Soruyu anlatamadım Yoksa bu konu hakkında en az 1 tane cevap alırdım. Ben bunu mutlaka öğrenirim ve öğrenince de paylaşırım iyi günler..

 

[musculus]

Kodlara minicik bir ilave işini görür sanırım
(koşullu biçimlendirmeyi kaldırmanı tavsiye ederim yoksa ilk renk farklı olabiliyor)

Option Explicit
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 = Application.Intersect(Target, Me.Range("b14:af14"))
If rng Is Nothing Then Exit Sub
With Target
Select Case UCase(.Value)

Case Is = "A": .Interior.ColorIndex = 19: .Offset(-1, 0).Interior.ColorIndex = 19: .Offset(-2, 0).Interior.ColorIndex = 19: .Offset(-3, 0).Interior.ColorIndex = 19: .Offset(-4, 0).Interior.ColorIndex = 19


Case Is = "B": .Interior.ColorIndex = 27: .Offset(-1, 0).Interior.ColorIndex = 27: .Offset(-2, 0).Interior.ColorIndex = 27: .Offset(-3, 0).Interior.ColorIndex = 27: .Offset(-4, 0).Interior.ColorIndex = 27
Case Is = "C": .Interior.ColorIndex = 7: .Offset(-1, 0).Interior.ColorIndex = 7: .Offset(-2, 0).Interior.ColorIndex = 7: .Offset(-3, 0).Interior.ColorIndex = 7: .Offset(-4, 0).Interior.ColorIndex = 7
Case Is = "D": .Interior.ColorIndex = 17: .Offset(-1, 0).Interior.ColorIndex = 17: .Offset(-2, 0).Interior.ColorIndex = 17: .Offset(-3, 0).Interior.ColorIndex = 17: .Offset(-4, 0).Interior.ColorIndex = 17
Case Is = "E": .Interior.ColorIndex = 35: .Offset(-1, 0).Interior.ColorIndex = 35: .Offset(-2, 0).Interior.ColorIndex = 35: .Offset(-3, 0).Interior.ColorIndex = 35: .Offset(-4, 0).Interior.ColorIndex = 35

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

ws_exit:
End Sub

 

[usta07]

Teşekkür ederim Sayın musculus istediğim kısmen oldu eğer birde clik olayına bağlayabilirsek veya otomatik olarak değiştirebilirse tam olacak Tekrar teşekkür ederim elinize sağlık.

 

[musculus]

clik ?

otomatik değişim ?

 

[usta07]

Private Sub CommandButton_Click() demek istemiştim. çünkü veriler değiştiğinde renkler değişmiyor (macro çalıştırmak gibi) Teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Kodu aşağıdaki şekilde de kullanabilirsiniz. Ayrıca zaten kodlar Change olayına yazılmış. Bu durumda 14. satırdaki değerler değiştiği zaman otomatikman çalışacaktır.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Hücre As Range
    Dim Satır As Long, Sütun As Byte
    On Error GoTo Son
    If Application.Intersect(Target, Range("B14:AF14")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    Satır = Target.Row
    Sütun = Target.Column
    With Target
    Select Case UCase(.Value)
    Case Is = "A": Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = 19
    Case Is = "B": Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = 27
    Case Is = "C": Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = 7
    Case Is = "D": Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = 17
    Case Is = "E": Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = 35
    Case Else
    Range(Cells(10, Sütun), Cells(Satır, Sütun)).Interior.ColorIndex = xlNone
    End Select
    End With
Son:
End Sub

 

[musculus]

Satır = Target.Row
Sütun = Target.Column
Range(Cells(10, Sütun), Cells(Satır, Sütun))

zekice .Hergün bir şey öğreniyorum teşekkürler

 

[usta07]

Çok teşekkür ederim sonunda istediğim oldu dosya büyüdüğü için sıkıştırıp gönderiyorum. Yurt dışı otel satışlarında kullanılan kost çalışması daha iyi hale getirmek isteyen arkadaş olursa vb pass= muhterem