mükerrer kayıtların engellenmesi

[ROUTER]

Merhabalar,

Emeği geçen herkese çok teşekkür ederim. Yeni üye oldum. Örnekler çok zengin. Ama ben mi bulamadım bilmiyorum. Sorunum çözümsüz mü ?
Aşağıdaki bağlantıda bu konuda çok örnek var. Bunları inceledim. Fakat ekteki gibi mükerrer kontrol yapan bir koda, formüle ulaşamadım. Yardımlarınızı rica ederim.
http://www.excel.web.tr/forumdisplay.php?f=120

Tablomdaki mükerrer kontrolü "Veri Doğrulama" ile yaptım. Mükemmel çalışıyor gibi görünsede dışarıdan veri koyalandığında (kopyala-yapıştır) veya tablo içinde sürükleme yapmamız halinde bunu algılamıyor. Elle girişlerde hatasız çalışıyor.
Kodlara baktığımda mükerrer satırı engelleyen örnekler çok. Ama bunlar ya hücreyi koparıyor (yukarı taşıyor) ya da satırı siliyor.
Veri Doğrulama örneğimdeki gibi sadece girilen değeri silmesi (hatta Yeniden Dene" ye tıkladığımızda mükerrer hücrenin içinde beklemesi) mümkün olacak bir kod var mıdır?
Saygılarımla.

 

[tahsinanarat]

Mükerrrer kayıt girdi uyarısı

Yukarıda ne istediğinizi pek anlamamakla birlikte, eğer a sutunuma aynı cins malzeme ismi yazıldığında uyarı vermesini istiyor ve sonucu evet ve hayır ile siz belirlemek istiyorsanız ekteki dosyayı inceleyiniz, yok farklı birşey istiyorsanız açık seçik izah edermisiniz. Kolay gelsin

 

[ROUTER]

mükerrer kayıt önleme

Sn tahsinanarat

Bir örnek ile anlatmaya çalıştım. Mükerrer kaydı önleyen bir kod var ve bunu iyileştirmek istiyorum.

Yardımlarınız için teşekkür ederim.

 

[Levent Menteşoğlu]

Dosyadaki mükerrer1 sayfasının kod sayfasındaki kodu silin ve yerine aşağıdakini kopyalayarak deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c2:c65536]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf([c:c], Target) > 1 Then
MsgBox ("Bu veriyi daha önce girdiniz. Lütfen listenizi kontrol ediniz."), vbCritical + vbRetryCancel, "Mükerrer Kayıt"
Target.Select
SendKeys "{F2}"
For a = 1 To Len(Target)
SendKeys "+{left}"
Next
End If
End Sub

veya çift girilen veriyi silmek isterseniz aşağıdaki gibide kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [c2:c65536]) Is Nothing Then Exit Sub
If WorksheetFunction.CountIf([c:c], Target) > 1 Then
MsgBox ("Bu veriyi daha önce girdiniz. Lütfen listenizi kontrol ediniz."), vbCritical + vbRetryCancel, "Mükerrer Kayıt"
Target.Select
Target = ""
End If
End Sub

 

[ROUTER]

mükerrer kayıtların önlenmesi

Levent Bey,
İlk verdiğiniz kodda "ESC" tuşuna basıldığında mükerrer veriyi artık görmüyor. Diğer yandan mükerrer satırın üzerinde odaklanması mükemmel.
İkinci kodda biraz değişiklik yapabilirseniz bu kod tamam olacak. Mükerrer satırı gördüğünde; o hücrede odaklansın. Yeniden deneye tıkladımda farklı bir değer girmezsem bırakmasın. İptal 'e bastığımda silsin.
Saygılarımla.

 

[Levent Menteşoğlu]

Bu durumda ilk kodu silip aşağıdaki kodları aynı modüle kopyalayarak deneyin.

Dim deg
 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [c2:c65536]) Is Nothing Or Selection.Count > 1 Then Exit Sub
deg = Target.Address
If WorksheetFunction.CountIf([c:c], Target) > 1 Then
Target.Select
sor = MsgBox("Bu veriyi daha önce girdiniz. Lütfen listenizi kontrol ediniz.", vbCritical + vbRetryCancel, "Mükerrer Kayıt")
If sor = vbCancel Then Target = ""
End If
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If deg = "" Then Exit Sub
If WorksheetFunction.CountIf([c:c], Range(deg)) > 1 Then Range(deg).Select
End Sub

 

[ROUTER]

Hocam ilginize teşekkür ederim. tamam demek istedim fakat;

tabloya farklı bir dosyadan veri koyalayıp-yapıştırdığınızda bunu algılamıyor.

Bana en uygun olanı seçtim. Önceki yazınızda verdiğiniz kodlardan ikincisi. Bu her yönüyle mükemmel çalışıyor. (odaklanma hari&#231
Bunu kullandığımda tam kontrol sağlamış olacağım.

Saolun.