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 sh As Worksheet
Dim x As Integer, i As Integer
Dim y As String
If Not Intersect(Target, [E:E]) Is Nothing Then
Set sh = Sheets("Sayfa1")
For i = 2 To sh.Cells(65536, 1).End(xlUp).Row
x = InStr(1, Target, sh.Cells(i, 1), vbTextCompare)
If x > 0 Then
MsgBox "Yasaklı Kelme Girişi yaptınız" _
& vbCrLf _
& "Yasak Kelime : " & sh.Cells(i, 1), vbCritical, "YASAK KELİME UYARISI"
y = Replace(Target, sh.Cells(i, 1), Application.WorksheetFunction.Rept(".", Len(sh.Cells(i, 1))), , , vbTextCompare)
Target = y
Exit For
End If
Next i
Set sh = Nothing
End If
End Sub