Fjerne dubletter i kolonne

Klik ind på den kolonne der skal undersøges, og start så makroen.

Baggrunden på dubletterne bliver rød.


Public Sub MakerDubletterRøde()
col = ActiveCell.Column
Rowcount = Cells(65536, col).End(xlUp).Row
Range(Cells(1, col), Cells(65536, col).End(xlUp)).Select
For I = 1 To Rowcount
If Cells(I, col).Interior.ColorIndex <> 3 Or Cells(I, col) <> "" Then
For I1 = I + 1 To Rowcount
If Cells(I, col) = Cells(I1, col) Then
Cells(I1, col).Interior.ColorIndex = 3
End If
Next
End If
Next
End Sub

Klik ind på en celle i den kolonne der skal undersøges, og start så makroen.
Baggrunden på dubletterne bliver rød.

Tjek om det er ok, så kan du køre den næste makro

Den næste makro sletter rækkerne med de røde celler
Der skal du også klikke ind på en celle i den kolonne der skal undersøges

Public Sub MakerDubletterRøde()
col = ActiveCell.Column
Rowcount = Cells(65536, col).End(xlUp).Row
Range(Cells(1, col), Cells(65536, col).End(xlUp)).Select
For I = 1 To Rowcount
If Cells(I, col).Interior.ColorIndex <> 3 Or Cells(I, col) <> "" Then
For I1 = I + 1 To Rowcount
If Cells(I, col) = Cells(I1, col) Then
Cells(I1, col).Interior.ColorIndex = 3
End If
Next
End If
Next
End Sub


Public Sub FjernDubletterRøde()
col = ActiveCell.Column
Rowcount = Cells(65536, col).End(xlUp).Row
Range(Cells(1, col), Cells(65536, col).End(xlUp)).Select
For I = 1 To Rowcount
If Cells(I, col).Interior.ColorIndex = 3 Then
Cells(I, col).EntireRow.Delete Shift:=xlUp
I = I - 1
Rowcount = Rowcount - 1
End If
Next
End Sub

Hvis det er kolonne A:A du skal finde dubletter i så sortere du alt på kolonne A:A. Herefter skriver du =MATCH(A1;A2;0)i celle B1 (tror formlen hedder =sammenlign i dansk Excel), herefter kopieres formlen ned langs det som skal testes. Marker kolonne B:B og kopier indsæt specielt "værdi" i samme kolonne.
Nu kan du så sortere på kolonne B:B og slette alle kolonner med tal, hvis der står #N/A findes værdien kun 1 gang.

kabak .. Rydder lige op ... Smider du et svar ....

et svar ;-))