koşullu biçimlendirme (8 koşul)

[oktaytamer]

merhaba herkese,
benim sorunum bir hücredeki değeri 8 değişik harf olarak seçmeye bağlı olarak başka bir hücrenin dolgu renginin değişmesi arkadaşlar örneğin a1 hücresine E harfi yazdığımda b1 hücresi yeşil renk olacak, s harfini seçtiğimde turuncu olacak gibi.
örnek dosya ektedir yardımcı olacak arkadaşlara hayır duasında bulunacağım.

 

[harpoon_1903]

Harfe göre renklendirme

Dosyanız ektedir. Umarım işinize yarar.

 

[oktaytamer]

tesekkürler

yardımınızdan dolayı çok teşekkür ederim ama istediğimi tam anlatamadım sanırım bu harflerden birini seçtiğimde aynı anda 4 ayrı hücrenin rengi değişecek.
yardımlarınızı bekliyorum herkesten

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu ilgili sayfanın kod bölümüne uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [B2]) Is Nothing Then Exit Sub
    Select Case Target
    Case "B"
    [B5].Interior.ColorIndex = 1
    [B6].Interior.ColorIndex = 2
    [B8].Interior.ColorIndex = 3
    [B9].Interior.ColorIndex = 4
    Case "E"
    [B5].Interior.ColorIndex = 5
    [B6].Interior.ColorIndex = 6
    [B8].Interior.ColorIndex = 7
    [B9].Interior.ColorIndex = 8
    Case "J"
    [B5].Interior.ColorIndex = 9
    [B6].Interior.ColorIndex = 10
    [B8].Interior.ColorIndex = 11
    [B9].Interior.ColorIndex = 12
    Case "K"
    [B5].Interior.ColorIndex = 13
    [B6].Interior.ColorIndex = 14
    [B8].Interior.ColorIndex = 15
    [B9].Interior.ColorIndex = 16
    Case "N"
    [B5].Interior.ColorIndex = 17
    [B6].Interior.ColorIndex = 18
    [B8].Interior.ColorIndex = 19
    [B9].Interior.ColorIndex = 20
    Case "R"
    [B5].Interior.ColorIndex = 21
    [B6].Interior.ColorIndex = 22
    [B8].Interior.ColorIndex = 23
    [B9].Interior.ColorIndex = 24
    Case "S"
    [B5].Interior.ColorIndex = 25
    [B6].Interior.ColorIndex = 26
    [B8].Interior.ColorIndex = 27
    [B9].Interior.ColorIndex = 28
    Case "T"
    [B5].Interior.ColorIndex = 29
    [B6].Interior.ColorIndex = 30
    [B8].Interior.ColorIndex = 31
    [B9].Interior.ColorIndex = 32
    Case Else
    [B5:B9].Interior.ColorIndex = 41
    End Select
End Sub

 

[N.Ziya Hiçdurmaz]

Yanıt

Alternatif.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2")) Is Nothing Then Exit Sub
For Each R In Range("B5,B6,B8,B9")
S = S + 1
If [B2] = "B" Then R.Interior.ColorIndex = S
If [B2] = "E" Then R.Interior.ColorIndex = S + 5
If [B2] = "J" Then R.Interior.ColorIndex = S + 45
If [B2] = "K" Then R.Interior.ColorIndex = S + 20
If [B2] = "N" Then R.Interior.ColorIndex = S + 25
If [B2] = "R" Then R.Interior.ColorIndex = S + 30
If [B2] = "S" Then R.Interior.ColorIndex = S + 35
If [B2] = "T" Then R.Interior.ColorIndex = S + 40
Next
End Sub

 

[oktaytamer]

Çok TeŞekkÜr Ederİm

Çok teşekür ederim tüm yardımcı olmak isteyen arkadaşlara.
V.Basic For Applications kullanıcı sının kodu tam istediğim gibi olmuş.
Ellerine sağlık dostum.
Tüm güzellikler sizinle olsun .