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 Hücre As Range
On Error GoTo Son
If Intersect(Target, Range("[COLOR=red]D10:J100[/COLOR]")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If WorksheetFunction.CountA(Selection) = 0 Then
For Each Hücre In Selection
If Not Intersect(Hücre, Range("[COLOR=red]D10:J100[/COLOR]")) Is Nothing Then
Target.Font.ColorIndex = 0
Target.Font.Bold = False
End If
Next
End If
Application.EnableEvents = True
If Target.Cells.Count > 1 Then Exit Sub
Select Case Target
Case Is = "a", "A"
Target.Font.ColorIndex = 0
Target.Font.Bold = True
Case Is = "b", "B"
Target.Font.ColorIndex = 45
Target.Font.Bold = True
Case Is = "c", "C"
Target.Font.ColorIndex = 8
Target.Font.Bold = True
Case Is = "d", "D"
Target.Font.ColorIndex = 54
Target.Font.Bold = True
Case Is = "a.i", "A.İ"
Target.Font.ColorIndex = 10
Target.Font.Bold = True
Case Is = "ü.i", "Ü.İ"
Target.Font.ColorIndex = 5
Target.Font.Bold = True
Case Is = "o", "O"
Target.Font.ColorIndex = 3
Target.Font.Bold = True
Case Else
Target.Font.ColorIndex = 0
Target.Font.Bold = False
End Select
Son:
Application.EnableEvents = True
End Sub
Merhaba,
Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz. Kırmızı renkli bölümler kodun çalışacağı hücre aralığıdır. Kendinize göre değiştirirsiniz.