mükerreri isteğe göre silme

[gelibolu]

ekteki dosyada mükerreri bulur ve siler ancak ben mükerreri bulduktan sonra yan sütuna bir şey yazılırsa silinmesini istemiyorum. Ayrıca kırmızı renkte üzerinden kalkmalı yardımlarınızı bekliyorum.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.

Sub Yinelenenleri_Sil()
    
    Dim i   As Long
    Dim Sat As Long
    Dim Adt As Integer
    Dim ws1 As Worksheet
    
    Set ws1 = Sheets("Sayfa1")
    
    ws1.Select
    
    Application.ScreenUpdating = False
    Sat = Cells(Rows.Count, "A").End(3).Row
    Range("A2:E" & Sat).Sort Key1:=[C1]
    
    For i = Sat To 2 Step -1
        If Application.WorksheetFunction.CountIf(Range("C2:C" & i), Cells(i, "C")) > 1 Then
            If Cells(i, "D") = "" Then
                Rows(i).Delete
                Adt = Adt + 1
            Else
                Range(Cells(i, "A"), Cells(i, "E")).Interior.ColorIndex = 3
            End If
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox Adt & " Adet Yinelenen Kayıt Silindi...", vbInformation, "N. YEŞERTENER --> [URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
    
End Sub

 

[gelibolu]

Üstat öncelikle ilginize teşekkür ederim... (33 nolu kayıt sip no almadığı halde kalıyor.)

malesef tercih etmediğim ilk mükerreri ilk veri ise silmiyor (çünkü boyamıyor ) bu durumda ikinci veri ise siliyor.Bu olmamalı Amacım:
....Düğmeye birinci basışta tüm plaka sütünuna göre tabloyu, artan sıraya sokmak,bütün mükerrer plakaları kırmızıya boyamak.
.... Kontrolü yaptıktan sonra sağında sipariş no alamamış bütün mükerrerleri silmek.


böylece 2 ayrı sistemden gelen sürekli bilgi girişi olan listemde tekilleri hızlıca bulmak, diğerlerinin silinmesini sağlamak. Yardımcı olursanız çok sevinirim....

 

[gelibolu]

üstad bu konuda sizin bana yardımcı olacağınızı umuyorum. Daha önceki çalışmalarınızdan çok faydalandım. Saygılarımla..