Excel Yinelenenler Hk

[cem13434]

Arkadaşlar Excel'de 1 Milyon veri var burdaki verilerin aynılarının hepsini kaldırılmasını istiyorum.


Yinelenenlerle kaldırmaya biliyorum ama 1 Adet orjinal veriyi bırakıyor onuda bırakmamasını istiyorum nasıl yol izlemeliyim teşekkür ederim.

Dip not benzersizleri bırak dedigimde çok veri oldugundan excelim kitleniyor

 

[Korhan Ayhan]

Merhaba,

İki farklı kod paylaşıyorum.

A sütunundaki verilerden 1 kez tekrar edenleri (yani mükerrer olmayanları) B sütununa listeler.

Hız olarak ilk kod daha hızlı sonuç veriyor.


1. Yöntem (Dictionary)

1 milyon satırlık veride işlem süresi = 39 Saniye

Option Explicit

Sub Benzersiz_Liste_Dictionary()
    Dim Benzersiz As Variant, Liste As Variant, X As Long
    Dim Veri As Variant, Say As Long, Zaman As Double
  
    Zaman = Timer
  
    Range("B:B").Clear
  
    Liste = Range("A1").CurrentRegion.Value
  
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Liste) To UBound(Liste)
            .Item(Liste(X, 1)) = .Item(Liste(X, 1)) + 1
        Next
  
        ReDim Benzersiz(1 To Rows.Count, 1 To 1)
      
        For Each Veri In .Keys
            If .Item(Veri) = 1 Then
                Say = Say + 1
                Benzersiz(Say, 1) = Veri
            End If
        Next
  
        .RemoveAll
    End With

    Range("B1").Resize(Say, 1) = Benzersiz
  
    Erase Liste
    Erase Benzersiz
  
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

2. Yöntem (ADO)

1 milyon satırlık veride işlem süresi = 175 Saniye

Option Explicit

Sub Benzersiz_Liste_Ado()
    Dim My_Connection As Object, My_Recordset As Object, Zaman As Double
 
    Zaman = Timer
  
    Range("B:B").Clear
 
    Set My_Connection = VBA.CreateObject("AdoDb.Connection")
 
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
     
    Set My_Recordset = My_Connection.Execute("Select F1 From [Sayfa1$] Group By F1 Having Count(F1) = 1")
  
    Range("B1").CopyFromRecordset My_Recordset
  
    If My_Connection.State <> 0 Then My_Connection.Close
  
    Set My_Connection = Nothing
    Set My_Recordset = Nothing
  
    MsgBox "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub