Excel: izbris obeh podvojenih vrednosti

Excel - težava

Ne razumem kje imaš problem ?

shinko je 3. apr 2012 ob 19:55 izjavil:

Zdravo,

iz baze moram izbrisat vse podvojene vrednosti. Ne samo "duplikat" ampak tudi "original". V bazi so imena, priimki, telefonska, mail,... Na netu sem naletel na to kodo za makro:

 Sub Delete_Duplicates()
 Dim r As Long
 Dim r2 As Long
 Dim CurrentVal As String
 Dim Unique As Boolean
 For r = 1 To Range("A65536").End(xlUp).Row
 CurrentVal = Range("A" & r).Value
 Unique = True
 For r2 = r + 1 To Range("A65536").End(xlUp).Row
 If Range("A" & r2).Value = CurrentVal Then
 Unique = False
 Range("A" & r2).EntireRow.Delete
 r2 = r2 - 1
 End If
 Next r2
 If Unique = False Then
 Range("A" & r).EntireRow.Delete
 r = r - 1
 End If
 Next r
 End Sub
 

Baza ima približno 5000 vnosov in računalnik melje že pol ure. A ve mogoče kdo če je ta koda ok, oz če še je kakšna druga varjanta prosim za nasvet.

LP

Tole kar si dal dela čisto lepo, vendar je časovno potratno. Za vsak row moraš pregledati n vrstic. V najslabšem primeru delaš 5000x5000 primerjav kar pa le nanese nekaj. Kar je predlagal smetko je ročna varianta, ki je hitrejša. V kolikor mora to biti makro imaš pa veliko možnosti za optimizacijo. Prva je že ta, da narediš sort podatkov in potem delaš drugo zanko samo do prve spremembe like:

       For r2 = r + 1 To Range("A65536").End(xlUp).Row
            If Range("A" & r2).Value = CurrentVal Then
                Unique = False
                Range("A" & r2).EntireRow.Delete
                r2 = r2 - 1
            Else
               Exit For
            End If
        Next r2

LP