Bu makro aynı sayfadaki (A2:A500) verilerden tekrarlananları siler. Makronun sorunsuz çalışması için veriler arasında boş hücre bulunmaması gerekir. Eğer listeniz boş hücre içeriyorsa verileri artan sıralayarak boş hücrelerin liste sonuna alınmasını sağlayın.

Kod: Tümünü seç

Sub TekrarYok()
Dim iListCount As Integer
Dim iCtr As Integer
' Makroyu hızlandırmak için ekran güncelleştirmeyi kapatıyoruz.
Application.ScreenUpdating = False
' Aranacak kayıt sayısı alınıyor.
iListCount = Sheets("Sayfa1").Range("A2:A500").Rows.Count
Sheets("Sayfa1").Range("A2").Select
' Kayıt sonuna kadar döngü yapılıyor.
Do Until ActiveCell = ""
' Kayıtlar arasında döngü gerçekleştiriliyor.
For iCtr = 1 To iListCount
' Farklı bir sütun belirtmek için, sütun numarasını 1 artırın.
If ActiveCell.Row <> Sheets("Sayfa1").Cells(iCtr, 1).Row Then
' Sonraki kaydı karşılaştırıyoruz.
If ActiveCell.Value = Sheets("Sayfa1").Cells(iCtr, 1).Value Then
' Eşleşme true değerine sahipse satırı siliyoruz.
Sheets("Sayfa1").Cells(iCtr, 1).Delete xlShiftUp
' Silinen satırı göz önüne alarak sayacı artırıyoruz.
iCtr = iCtr + 1
End If
End If
Next iCtr
' Sonraki kayda geçiyoruz.
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Tekrarlanan kayıtlar silindi"
End Sub