Kendini tekrar eden bilgiler

[SUHAOZBEK]

Merhaba,
Örnekte kendini tekrar eden bilgiler mevcut. Tekrar eden bilgilerin bir tanesi kalacak şekilde satır sırası değişmeden silinmesi hakkında yardımınızı rica ediyorum.
Teşekkürler,
İyi çalışmalar.
Ek yapamadığım için sütunu aşağıya yapıştırdım.

SIRA NUMARASI

01.01.2022_2121_1_148753

01.01.2022_2121_1_148756

01.01.2022_2121_1_148758

01.01.2022_2121_1_148758

01.01.2022_2121_1_148758

01.01.2022_2121_1_148761

01.01.2022_2121_1_148762

01.01.2022_2121_1_148763

02.01.2022_2121_1_148780

02.01.2022_2121_1_148780

02.01.2022_2121_1_148795

02.01.2022_2121_1_148797

02.01.2022_2121_1_148797

02.01.2022_2121_1_148798

02.01.2022_2121_1_148799

02.01.2022_2121_1_148802

02.01.2022_2121_1_148803

02.01.2022_2121_1_148808

02.01.2022_2121_1_148809

02.01.2022_2121_1_148810

02.01.2022_2121_1_148811

02.01.2022_2121_1_148812

02.01.2022_2121_1_148813

02.01.2022_2121_2_93933

03.01.2022_2121_1_148837

03.01.2022_2121_1_148838

03.01.2022_2121_1_148841

03.01.2022_2121_1_148841

03.01.2022_2121_1_148842

03.01.2022_2121_1_148845

03.01.2022_2121_1_148845

03.01.2022_2121_1_148846

03.01.2022_2121_1_148847

03.01.2022_2121_1_148847

03.01.2022_2121_1_148848

03.01.2022_2121_1_148849

03.01.2022_2121_1_148851

 

[Hakan ERDOST]

Sub RemoveDuplicates()
    Dim LastRow As Long
    Dim i As Long
    
    'Sütun A'da işlem yapmak için kod, A sütununu siler sütunu dğiştirebilirsiniz.
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    'Tekrar eden satırları kaldır
    For i = LastRow To 2 Step -1
        If Cells(i, "A") = Cells(i - 1, "A") Then
            Rows(i).Delete
        End If
    Next i
End Sub

'seçili sütun silinsin diyorsanız
'Sub RemoveDuplicates2()
'imlecin olduğu yada seçili sütunu siler
    'Dim LastRow As Long
   ' Dim i As Long
    
    'Seçili sütunun son satır numarasını belirle
    'LastRow = Cells(Rows.Count, Selection.Column).End(xlUp).Row
    
    'Tekrar eden satırları kaldır
    'For i = LastRow To 2 Step -1
     '   If Cells(i, Selection.Column) = Cells(i - 1, Selection.Column) Then
      '      Rows(i).Delete
       ' End If
    'Next i
'End Sub

' Satırlar boş kalsın diyorsanız
'Sub RemoveDuplicates3()
  '  Dim LastRow As Long
    'Dim i As Long
    
    ''Sütun A'da işlem yapmak için kodu değiştirin
   ' LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    '
    ''Tekrar eden satırları kaldır
    'For i = LastRow To 2 Step -1
       ' If Cells(i, "A") = Cells(i - 1, "A") Then
          '  Rows(i).ClearContents ' Satır içeriğini sil
     '   End If
  '  Next i
'End Sub

Dosyanız ektedir.

 

[SUHAOZBEK]

Yardımlarınız için çok teşekkür ederim Son kod çok işime yaradı. 70 Bin satır uzun sürdü ama başarılı.
Sevgiler,
Saygılar.

 

[Hakan ERDOST]

Rica ederim.Kolay gelsin.

 

[Korhan Ayhan]

Alternatif..

Sütunu seçtikten sonra VERİ menüsünden YİNELENENLERİ KALDIR seçeneğini kullanabilirsiniz.