DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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("a:a"))
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.
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 Else
.Interior.ColorIndex = xlNone
End Select
End With
ws_exit:
End Sub
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Hücre As Range
Range("T12:T31").Font.ColorIndex = 0
For Each Hücre In Range("T12:T31")
If Hücre.Text = "Nakit Talep ve Tasisler Hsb." Or _
Hücre.Text = "Gelir Hesabı" Or _
Hücre.Text = "Gelir Yansıtma Hesabı" Or _
Hücre.Text = "0" Then
Range("B" & Hücre.Row, "N" & Hücre.Row).Font.ColorIndex = 2
End If
Next
End Sub
Selamlar,
Siz formülle değerler üretiyorsunuz. Oysaki kullanmaya çalıştığınız kod sayfada hücre içeriği değişiminde tetiklenen kod yapısıdır. Sizin kodu sayfada hücre seçimi değişiminde çalışacak olaya yazmanızda fayda var.
End Sub[/code]