MsgBox uyarısı almak

[arifbirgen]

Değerli Arkadaşlar
Örnekte açıklama var.Ad soyad aynı satıra girilmiş ise ikinci kez
girildiğinde Bu ad soyad var MsgBox uyarısı almak istiyorum.Yardımcı
olursanız sevinirim.

 

[leumruk]

Merhaba,

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("b6:l95")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Say = WorksheetFunction.CountIf(Range(Cells(Target.Row, "b"), Cells(Target.Row, "l")), Target)
If Say > 1 Then
Sor = MsgBox("Bu ismi " & Say & ". defa giriyorsunuz. Yine de kaydetmek istiyor musunuz?", vbYesNo, "UYARI")
If Sor = vbNo Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
End If
End If
Son:
End Sub

 

[arifbirgen]

Sn: Leumruk
Çok çok teşekkür ederim.İyi çalışmalar.

 

[leumruk]

Sn: Leumruk
Çok çok teşekkür ederim.İyi çalışmalar.

Rica ederim. k::

 

[arifbirgen]

Sn: Leumruk Hocam

Örnekte açıklama yaptım.Bir ad soyad aynı sayfada adrese
göre MsgBox uyarısı almak mümkünmü.Adrese göre olursa
daha çok işime yarayacak.Örneğin:Arif ismi B6;L30 da ikinci
defa girilince uyarı,Arif ismi B31;L60 adresine birkez yine yazılmalı
bu adrese ikinci defa girilince uyarı,B61;L90 adresi içinde aynı
üç ayrı adrese birer defa arif ismi yazılmalı.Bu konudada yardımcı olursanız
memnun olurum.

 

[leumruk]

Kodu örnekteki dosyanıza ekleyip deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("b6:l35, b36:l65, b66:l95")) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Set Aralik = Range("b6:l35")
If Not Intersect(Target, Range("b36:l65")) Is Nothing Then
Set Aralik = Range("b36:l65")
ElseIf Not Intersect(Target, Range("b66:l95")) Is Nothing Then
Set Aralik = Range("b66:l95")
End If
Say = WorksheetFunction.CountIf(Aralik, Target)
If Say > 1 Then
Sor = MsgBox("Bu ismi " & Say & ". defa giriyorsunuz. Yine de kaydetmek istiyor musunuz?", vbYesNo, "UYARI")
If Sor = vbNo Then
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
End If
End If
Son:
End Sub