Soru TEKRARLAYAN SATIRLARI BULMAK

Katılım
9 Şubat 2022
Mesajlar
204
Excel Vers. ve Dili
Office 2021 Türkçe (x64)
Altın Üyelik Bitiş Tarihi
09-02-2027
Merhaba, amacım bire bir, hangi satırların tekrar ettiğini bulmak.
Çalışma kitabımda, tekrarlananları kaldırdığımda, excel 250 civarında satırın yinelendiğini yazıyor. Ama bunlar hangi satırlar?

Her seferinde, yinelenenleri kaldırdıktan sonra kalanlarla, orjinal veriyi DÜŞEYARA ile karşılaştırarak, tekrarlayan satırları buluyorum.
Bunu makro ile daha pratik şekilde ve 900.000 satırda makul bir süre içerisinde bulup yeni sayfaya yazdırabilen bir makroya ihtiyacım var.
Sık karşılaşılan bir ihtiyaç olduğunu düşünüyorum, hazırda böyle bir koda sahip olanlar paylaşırsa büyük zahmetten kurtulacağım.
 
Son düzenleme:

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

251776

Bu örnekte hangi satırları eşleşmiş olarak kabul ediyorsunuz?
 
Katılım
9 Şubat 2022
Mesajlar
204
Excel Vers. ve Dili
Office 2021 Türkçe (x64)
Altın Üyelik Bitiş Tarihi
09-02-2027
Üstad, tabloda 1 ve 3. satırların her ikisi de tekrarlı.
Satırdaki tüm sutunlardaki verinin aynen tekrar ettiği durumlarda, satır tekrarı olduğunu kabul ediyorum.
Nihai amacım verinin çoklanmasının kaynağını bulmak.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Aşağıdaki kodu deneyiniz.

Kod:
Sub Test()
    Dim Bak As Integer
    Dim Alan As String
    Dim SatirSay As Long
    Dim SutunSay As Integer

    Application.ScreenUpdating = False
    SutunSay = Cells(1, Columns.Count).End(xlToLeft).Column
    
    For Bak = 2 To SutunSay
        Alan = IIf(Alan = "", Cells(2, Bak).Address(False, False), Alan & "&" & Cells(2, Bak).Address(False, False))
    Next
    
    SatirSay = Cells(Rows.Count, "A").End(xlUp).Row
    Range(Cells(2, SutunSay + 1).Address & ":" & Cells(SatirSay, SutunSay + 1).Address).Formula = "=" & Alan
    With Range(Cells(2, SutunSay + 2).Address & ":" & Cells(SatirSay, SutunSay + 2).Address)
        .FormulaLocal = "=EĞER(EĞERSAY(" & Columns(SutunSay + 1).Address & ";" & Cells(2, SutunSay + 1).Address(False, False) & ")>1;""Yinelenen Satır"";"""")"
        .Value = .Value
    End With
    Columns(SutunSay + 1).Delete
    Application.ScreenUpdating = True
End Sub
 
Katılım
9 Şubat 2022
Mesajlar
204
Excel Vers. ve Dili
Office 2021 Türkçe (x64)
Altın Üyelik Bitiş Tarihi
09-02-2027
Teşekkürler Muzaffer üstad, makronun işlem mantığı sağlam duruyor, 5.000 satırlık örnek üzerinde denedim, makro çok hızlı
ancak #DEĞER! hatası verdi, (son sütuna yazdığı sonuçların hepsi aynı şekilde) sanırım bu taslak üzerinden yola çıkıp düzeltebilirim.
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,167
Excel Vers. ve Dili
2019 Türkçe
Rica ederim.
Örnek dosya eklerseniz kontrol sağlayabilirim.
 
Katılım
9 Şubat 2022
Mesajlar
204
Excel Vers. ve Dili
Office 2021 Türkçe (x64)
Altın Üyelik Bitiş Tarihi
09-02-2027
Akşam biraz kendim uğraşayım, tam sonuca ulaşınca paylaşırım üstad.
 
Üst