Makroyu bir hücreye uyarlama ve uyarı mesajı çıkarma

[CyberBlade_]

Arkadaşlar merhaba;

Linkteki problemimin bir kısmını çözdüm en azından koşullu biçimlendirme ile daha anlaşılır duruma getirdim. Ve içinden çıkamadığım iki durum var.

Birincisi; Bu VBA kodunu sadece A1 kodu için uyarlayamadım.

İkincisi ise; Bu koda koşullu biçimlendirmedeki " =EHATA(BUL("@";A1)) " formülü eğer doğruyu getiriyorsa yani hücrede sayı yada harf var ama "@" işareti yoksa bir uyarı mesajını nasıl çıkarabilirim?

http://www.excel.web.tr/f48/e-mail-formaty-kontrolu-t95097.html


Yardımınız ve cevaplarınız için şimdiden teşekkürler. Yaptığım dosya ektedir.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Eski_Karakter As Variant, Yeni_Karakter As Variant, X As Byte
    On Error GoTo Son
    If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
    If Target <> "" Then
        Eski_Karakter = Array("ç", "Ç", "ğ", "Ğ", "ı", "İ", "ö", "Ö", "ş", "Ş", "ü", "Ü")
        Yeni_Karakter = Array("c", "C", "g", "G", "i", "I", "o", "O", "s", "S", "u", "U")
        For X = 0 To UBound(Eski_Karakter)
            Application.EnableEvents = False
            Target = Replace(Target, Eski_Karakter(X), Yeni_Karakter(X))
            Application.EnableEvents = True
        Next
        
        If InStr(1, Target, "@") = 0 Or InStr(1, Target, "@.") > 0 Or Len(Target) - Len(Replace(Target, "@", "")) > 1 Then
            MsgBox "Lütfen E-Mail biçiminde veri girişi yapınız !", vbCritical
            Application.EnableEvents = False
            Target = ""
            Target.Select
            Application.EnableEvents = True
            Exit Sub
        End If
    End If
    
Son: Application.EnableEvents = True
End Sub

 

[CyberBlade_]

Selam Korhan Bey,

Tam yapmak istediğim şey. Çok teşekkür ederim.

İyi akşamlar.