Ara Bul Aynısı varsa sil?

[lovekiller]

Arkadaşlar merhaba.
Bir çalışma kitabımız var.Veriler oldukça uzun ve sürekli güncelleniyor.Satırlar şu şekilde:
---A------- B-------C---------D----------E-----
Sıra No İsim Soyisim Cinsiyet Doğum Yılı

B,C,D ve E satırına daha önce girilmiş verinin aynısı girildiğinde uyaracak ve girişi silecek bir makro yapmak istiyoruz.
Yardımcı olabilecek arkadaşlara teşekkür ederim.

 

[veyselemre]

aşağıdaki kodları sayfanın kod bölümüne yaz,işini görecek mi?

[vb:1:7de6b00e35]Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If Target.Column <> 6 Then Exit Sub ' burası aktif olursa yalnızca kontrolü f sütununa geçince yapar
For x = 2 To [b65536].End(3).Row
toplam1 = WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(x, 2)), Cells(x, 2))
toplam2 = WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(x, 3)), Cells(x, 3))
toplam3 = WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(x, 4)), Cells(x, 4))
toplam4 = WorksheetFunction.CountIf(Range(Cells(2, 2), Cells(x, 5)), Cells(x, 5))
If toplam1 > 1 And toplam2 > 1 And toplam3 > 1 And toplam4 > 1 Then
If MsgBox(x & ".Satırdaki Veri Daha Ã?nce Girilmiş, Silmek İstiyor musunuz?", vbYesNo, "Uyarı") = vbYes Then Range(Cells(x, 2), Cells(x, 5)).Delete
End If
Next
End Sub
[/vb:1:7de6b00e35]

 

[lovekiller]

Sayın veyselemre
İlginize teşekkürler.Kodlarınız çalışıyor ancak tam olarak benim istediğim olmadı.Burada amaç aynı isim,soyisim,cinsiyet ve doğum yılına sahip girişi engellemek.Kodlarınızda örneğin doğum yıllarını kontrol ettiğinde onlarca aynı yarih var ve hepsini tek tek soruyor.Burada önemli olan bir bütün halinde B,C,D,E sütunlarına girilen verileri kontrol etmek.Yani isim aynı soyisim aynı cinsiyet aynı ve doğum tarihi de aynı olduğunda bizi uyarması ve giriş yaptırmaması.
Tekrar teşekkürler.

 

[veyselemre]

bir de şöyle deneyin


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If Target.Column <> 6 Then Exit Sub ' burası aktif olursa yalnızca kontrolü f sütununa geçince yapar
For x = 2 To [b65536].End(3).Row - 1
For y = x + 1 To [b65536].End(3).Row
alan1 = Cells(x, 2) & Cells(x, 3) & Cells(x, 4) & Cells(x, 5)
alan2 = Cells(y, 2) & Cells(y, 3) & Cells(y, 4) & Cells(y, 5)
If alan1 = alan2 Then
If MsgBox(y & ".satırdaki veri " & x & ".nci satırda girilmiş," & y & ".satırı silmek istiyor musunuz?", vbYesNo, "Uyarı") = vbYes Then Range(Cells(y, 2), Cells(y, 5)).Delete
End If
Next
Next
End Sub

 

[lovekiller]

Sayın veyselemre kodlarınızı denedim ancak istediğim sonucu yine alamadım.Sanırım tam olarak istediğimi anlatamadım.İstediğim B,C,D,E ye girdiğim verilerin birebir aynısı olduğunda (tek tek kontrol olmayacak)örneğin
1 Ali Tan E 1979
2 Ali Tan E 1979
ikinci satırda tüm verilerin aynısını girdiğimde satırı silsin.
Sizin kodlarda sürekli uyarı veriyor.Çünkü örneğin Ali yada 1979 olan bir sürü veri var.Hepsi için tek tek uyarı veriyor.Ben şu kodları denedim ama bu da tek sütun için kontrol ediyor ve geliştiremedim:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column =  5 Then
If WorksheetFunction.CountIf(Range("E1:E" & Target.Row - 3), Target) > 0 Then
sat = Range("E1:E" & Target.Row - 3).Find(Target.Value).Row
MsgBox "BU İSİM KAYITLIDIR" & Chr(10) & Cells(sat, 2).Value & Chr(10) & Cells(sat, 3).Value & Chr(10) & Cells(sat, 4).Value
Target.Clear
Target.Select
End If
End If
End Sub

Teşekkürler.

 

[veyselemre]

ben denedim doğru çalışıyor

 

[lovekiller]

Günaydın
Evet haklısınız.Kodlar geçekten çalışıyor.Ama bizim çalışma kitabında şu an bile 200 satır dolu olduğu için oldukça zorlanıyor.Her veri girişinde tarama yaptığı için oldukça yavaşlattı.
İlginize teşekkürler.

 

[root]

Þöyle bir inceldim de bana buna benzer birşey lazim..

Yanlız çok büyük bir alanı tarıyoyor...

Tarayacağı hücreleri a1 elle yazıp..

aynı olanlari renklendirmesini isteyebilirmiyim acaba yardımcı olursanız sevinirim..

Unuttuğum birşey var.. her aynı olanlaari acaba farklı renklere boyayabilirmi..

en fazla 10 renk belirlenir zaten tek tablo içinde ondan fazla hata çıkacağını sanmıyorum..