Mukerrer Kayıt Kontrolü

[OoParadiSeoO]

Arkadaşlar merhaba,
A sütununa mukerrer bir kayıt girdiğimiz zaman, "Mukerrer kayit girdiniz devam etmek istiyor musunuz?" Evet/Hayir opsiyonu sunan bir makro koduna ihtiyacım var.. Yardımlarınız için teşekkür ederim..

 

[muygun]

Merhaba;
Sayfanın kod bölümüne;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("a1:a65536")) Is Nothing Then
sat = Target.Row
sonsat = Range("A65536").End(xlUp).Row
If WorksheetFunction.CountIf(Range("a1:a" & sonsat), Cells(sat, "a")) > 1 Then
Secim = MsgBox("Mukerrer kayit girdiniz devam etmek istiyor musunuz? ( Evet / Hayır ).", _
vbExclamation + vbYesNo + vbDefaultButton3, "MsgBox Title")
If Secim = vbNo Then
Cells(sat, "a") = ""
Cells(sat, "a").Select
End If
If Secim = vbYes Then
MsgBox ("İşleme devam")
End If
End If
End If
End Sub

Kodlarını ekleyerek deneyin.
İyi çalışmalar.

 

[turist]

Alternatif.
Sayfa Kodu olarak deneyin.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = Empty Then Exit Sub
If Intersect(Target, Columns(1)) Is Nothing Then Exit Sub
say = Application.WorksheetFunction.CountIf(Columns(1), Target)
If say > 1 Then
cevap = MsgBox("Mükerrer Kayıt Girdiniz, Devam Etmek İstiyor musunuz?", vbYesNo)
If cevap = vbNo Then
Target.ClearContents
Exit Sub
End If
End If
End Sub

 

[Haluk]

Makrosuz alternatif;

-"A" sütununu seçin,

-"Veri Doğrulama" menüsünü çalıştırın,

-"İsteğe Bağlı" bölümünde "Formül" kısmına aşağıdakini yazıp, pencereleri onaylayarak kapatın...

=EĞERSAY($A:$A;A1)<2

.

 

[OoParadiSeoO]

Hepinize çok teşekkür ederim arkadaşlar, Elinize emeğinize sağlık...

 

[turist]

Hepinize çok teşekkür ederim arkadaşlar, Elinize emeğinize sağlık...

Sağ olun, iyi çalışmalar.