Çoklu yinelenenleri kaldırma

[bydilaver]

Selamlar

A,B,C,D,E,F,G,H,I,J,K,L,M,N,O Sütunlarında 500.000 satır veri var ve benim bunların hepsini yinelenenleri kontrol ettirmem gerekiyor tekrarların kalkması için.

şuan yaptığım eleme yöntemim yeni gelen veriyi tum sütünlarda tek tek kontrol ettiriyorum ve bu çok zaman kaybettirmekte

bunun için nasıl bir çözüm bulabiliriz.

yeni gelecek veriyi p sütuna koyarak toplu olarak kontrol ettirebilirmiyiz.

Makroda olabilir

şimdiden teşekkür ederim.

 

[ExcelF1]

.........................

 

[Korhan Ayhan]

Merhaba,

Bende çoklu tekrarlananların silinmesi için gerekli olan kodu hazırladım. Deneyiniz.

Not: Tekrar sayısı fazla ise kod biraz yavaş sonuç verecektir.

Sub YİNENELENENLERİ_KALDIR()
    Dim Bul As Range, Adres As String
    Dim Veri As Range, Kayit_Say As Long, Say As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Son = Cells(Rows.Count, "P").End(3).Row
    
    For Each Veri In Range("P1:P" & Son)
        If Veri <> "" Then
            Kayit_Say = WorksheetFunction.CountIf(Range("A:O"), Veri)
            If Kayit_Say > 1 Then
                Set Bul = Range("A:O").Find(Veri, , , xlWhole)
                If Not Bul Is Nothing Then
                    Adres = Bul.Address
                    Do
                        Bul = Empty
                        Set Bul = Range("A:O").FindNext(Bul)
                        Say = WorksheetFunction.CountIf(Range("A:O"), Veri)
                        If Say = 1 Or Bul Is Nothing Then Exit Do
                    Loop While Not Bul Is Nothing And Bul.Address <> Adres
                End If
            End If
        End If
    Next
    
    On Error Resume Next
    Range("A:O").SpecialCells(xlCellTypeBlanks).Delete xlUp
    On Error GoTo 0
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "Eşleşen kayıt sayısı ; " & Kayit_Say, vbInformation
End Sub