DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [F:F]) Is Nothing Then Exit Sub
Target.Offset(0, 1).Font.Bold = True
If Target.Value = "Kabul" Then
Target.Offset(0, 1) = "J"
Target.Offset(0, 1).Font.Color = vbGreen
ElseIf Target.Value = "Bekleme" Then
Target.Offset(0, 1) = "K"
Target.Offset(0, 1).Font.Color = vbBlue
ElseIf Target.Value = "İade" Then
Target.Offset(0, 1) = "L"
Target.Offset(0, 1).Font.Color = vbRed
Else
Target.Offset(0, 1) = ""
Target.Offset(0, 1).Font.Color = 0
Target.Offset(0, 1).Font.Bold = False
End If
Son:
End Sub
Sayın Necdet Yeşertener, çok teşekkür ederim, elinize sağlık,Merhaba,
G sütununu Wingdings olarak biçimlendirdikten sonra, aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp dener misiniz?
Kod:Option Compare Text Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Son If Intersect(Target, [F:F]) Is Nothing Then Exit Sub Target.Offset(0, 1).Font.Bold = True If Target.Value = "Kabul" Then Target.Offset(0, 1) = "J" Target.Offset(0, 1).Font.Color = vbGreen ElseIf Target.Value = "Bekleme" Then Target.Offset(0, 1) = "K" Target.Offset(0, 1).Font.Color = vbBlue ElseIf Target.Value = "İade" Then Target.Offset(0, 1) = "L" Target.Offset(0, 1).Font.Color = vbRed Else Target.Offset(0, 1) = "" Target.Offset(0, 1).Font.Color = 0 Target.Offset(0, 1).Font.Bold = False End If Son: End Sub
Sayın uzmanamele,fonksiyon alternatifi olsun.
syn Necdet hocam belirtmiş ama Wingdings ile yazılınca bu şekillerin çıktığı yöntem, syn brain'den (ç)alıntıdır.