mükerrer kayıt bulsun ancak silinip silimneyeceğini sorsun

[acolkesen1]

Merhaba değerli dostlar. Mükerrer kayıt konusunda örnek çok ama,aradığımı bulamadım bir türlü..Yapmak istediğim; sadece bir sütunda( ör: A:A) mükerrer kayıt olduğunda bunu bildiren bir uyarı mesajı versin. Buraya kadar oluyor ancak, uyarı mesajında varsayılan seçenek "hayır" olarak gelsin," hayır" ı onayladığımda silmeden devam etsin, "evet" i onaylarsam veriyi silerek devam etsin. Yaptığım denemelerde, silmeden devam ediyor ancak her hücre değişiminde aynı uyarı mesajını tekrarlıyor. Bununla ilgili kodu yazan biri çıkarsa sevinirim. Sanırım mümkündür. Şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayınız.

Public Sub Bul()
For i = [A65536].End(3).Row To 2 Step -1
    Adet = Application.WorksheetFunction.CountIf(Range("A2:A" & i), Cells(i, "A"))
    If Adet > 1 Then
        Evet = InputBox(i & ". Satırda " & Cells(i, "A") & " Değeri Fazladan Var, Sileyim mi?", "Silme Ekranı", "Hayır")
        If Evet = "Evet" Or Evet = "E" Or Evet = "e" Then Rows(i).Delete
        If Evet = "" Then Exit For
    End If
Next i
End Sub

 

[Orion1]

Aşağıdaki kod işinizi görebilir.

Sub mukererrer_sil()
Dim i As Long
For i = Cells(65536, "A").End(xlUp).Row To 1 Step -1
    If WorksheetFunction.CountIf(Range("A1:A65536"), Cells(i, "A").Value) >= 2 Then
        If MsgBox("[ " & Cells(i, "A").Value & " ] değerinden 1den fazla var.Bu değeri silmek istermisinzi.!!", vbYesNo + vbQuestion, "DİKKAT") = vbYes Then
            Rows(i).Delete
        End If
    End If
Next i
End Sub

 

[acolkesen1]

Dostlar her ikinize de teşekkürler. Bu kadar hızlı beklemiyordum. Bir deneyelim bakalım..

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Not IsEmpty(Target) Then
    If WorksheetFunction.CountIf([A:A], Target) > 1 Then
    ONAY = MsgBox("Mükerrer kayıt !" & vbCrLf & "Silmek istiyor musunuz ?", vbYesNo + vbDefaultButton2 + vbCritical, "DİKKAT !")
    If ONAY = vbYes Then
    Target.Clear
    Target.Select
    Else
    Exit Sub
    End If
    End If
    End If
End Sub

 

[acolkesen1]

Sevgili Orion2, kod gayet güzel çalışıyor ama,benim yapmak istediğim, mükerrer kayıt girildikten sonra enter ya da tab tuşuna basıldığında mesaj kendiliğinden çıksın ve MsgBox daki tercihime göre devam etsin. Şimiden teşekkürler..

 

[acolkesen1]

Evet bu oldu.. Cost_Control'a sonsuz teşekkürler.. Karşılıksız paylaşmayı seçen herkese sevgiler..