Baştaki mükerrer kayıtlar silinsin

[tahsinanarat]

A sutununda tc kimlik numaralarına göre mükerrer olan kayıtlar silinecek, tek bir satır kalacak, Kalacak olan bu satır en sondaki satır olmalı.
Teşekkürler

 

[Ömer]

Merhaba,

Bu şekilde deneyiniz..

Option Explicit

Sub İlkMükerrerleriSil()
Application.ScreenUpdating = False
Dim i As Long, son As Long
son = [A65536].End(3).Row
    For i = son To 2 Step -1
        If WorksheetFunction.CountIf(Range("A" & i & ":A" & son), _
        Cells(i, "A").Value) > 1 Then
            Rows(i).Delete
        End If
    Next i
Application.ScreenUpdating = True
End Sub

.

 

[tahsinanarat]

Elinize sağlık Ömer hocam, mükemmel olmuş, Çok teşekkür ediyorum.

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak iki farklı kodda ben hazırladım. İncelermisiniz.

Option Explicit
 
Sub İLK_MÜKERRER_SATIRLARI_SİL_2()
    Dim X As Long
    
    Application.ScreenUpdating = False
    
    For X = 2 To Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(Range("A:A"), Cells(X, 1)) > 1 Then
            Rows(X).Clear
        End If
    Next
    
    On Error Resume Next
    Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub