Duplikaattien poisto kokonaan

Minä tekisin tuon siten, että ensin tekisin apusarakkeen isompaan, johon tulee rivinumerot 1,2...50000. Tuo sen vuoksi, että alkuperäinen järjestys saadaan säilytettyä pienen pyörittelyn jälkeen.

Sitten hakisin isomman taulukon yhteen sarakkeeseen jokaista isomman taulukon kolmossarakkeen arvoa pienemmän taulukon kolmossarakkeista VLOOKUP-funktiolla, esim =VLOOKUP(C1;pikkutaulu.C:C;1;0). Tämä funktio siis isomman taulukon omaan sarakkeen ensimmäiselle (hakuarvon sisältävälle, tässä tapauksessa C1) riville.

Tuo funktio palauttaa ko.arvon, jos se löytyy pienemmästä taulukosta, jos taas ei, niin palauttaa #N/A.

Sen jälkeen järjestetään isompi taulukko VLOOKUP-funktion sarakkeen mukaiseen järjestykseen. Ei duplikaatit rivit järjestyvät #N/A-arvon vuoksi peräkkäin. Sen jälkeen voi poistaa helposti ne muut rivit, jotka ovat taulukossa peräkkäisillä riveillä.

Lopuksi järjestetään isompi taulu uudelleen alkuperäiset rivinumerot sisältävän apusarakkeen mukaiseen järjestykseen ja viimeistellään taulukko poistamalla se ja VLOOKUP-kaavan sisältävä sarake.

moduuliin...
Sub EtsiJaPoista()
Dim vika As Long
Dim solu As Range
Dim cainoa As New Collection
Dim i As Long
Dim uList() As Variant
'muuta taulukon nimi oikeaksi
Worksheets("Sheet2").Activate
' muuta sarake oikeaksi
vika = Range("C" & Rows.Count).End(xlUp).Row
Application.Volatile
On Error Resume Next
' muuta sarake oikeaksi
For Each solu In Range("C1:C" & vika)
If solu.Formula <> "" Then
cainoa.Add solu.Value, CStr(solu.Value)
End If
Next solu
If cainoa.Count > 0 Then
ReDim uList(1 To cainoa.Count)
For i = 1 To cainoa.Count
uList(i) = cainoa(i)
Next i

End If
'muuta nimi oikeaksi
Worksheets("Sheet1").Activate
For i = 1 To UBound(uList)
' muuta sarake oikeaksi
EtsiJaSiirrä(uList(i), Range("C:C")).EntireRow.Delete
Next
On Error GoTo 0
End Sub

Function EtsiJaSiirrä(Hakuehto As Variant, Hakualue As Range) As Range
Dim solu As Range
Dim EkaOsoite As String
Worksheets("Sheet1").Activate
On Error Resume Next
With Hakualue
Set solu = .Find( _
What:=Hakuehto, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not solu Is Nothing Then
Set EtsiJaSiirrä = solu
EkaOsoite = solu.Address
Do
Set EtsiJaSiirrä = Union(EtsiJaSiirrä, solu)
Set solu = .FindNext(solu)
Loop While Not solu Is Nothing And solu.Address <> EkaOsoite
End If
End With

End Function


Keep EXCELing
@Kunde