Eliminazione dati doppioni da un elenco

Impiego: ricerca ed eliminazione intera riga di dati doppi contenuti in un elenco (tabella)

 

A gentile richiesta (??), pensando che potrà interessere altri visitatori, propongo questa macro realizzata in seguito ad una domanda rivoltami: automatizzare con il Vba, la ricerca in un elenco, di dati doppi,  e loro eliminazione insieme ad eventuali dati correlati (quindi eliminazione dell'intera riga). E' un applicazione utile quando si debba avere a che fare con lunghi elenchi di dati, come per esempio una gestione di articoli di un magazzino, dove può capitare di inserire più volte una stessa voce, e dove quindi sia necessario rivedere e correggere l'elenco. Il funzionamento di queste istruzioni è semplice: si basa prima su un ordinamento A-Z dei dati presenti, basato su una chiave di ordinamento, che potrebbe essere il codice articolo (contenuti in questo esempio nella colonna B) con scartamento di eventuali righe vuote (che bloccherebbero il ciclo Do While...Loop) e nella ricerca del valore di ogni cella (a scalare) con i valori delle successive : nel caso vengano riscontrati valori uguali, la riga che contiene il doppione verrà eliminata. Ognuno potrà modificare i Range su cui eseguire il controllo, adattandoli alle proprie esigenze. Questo è il codice da associare ad un pulsante che risiederà nelle stesso foglio su cui si esegue la ricerca

:

Sub EliminaDoppioni()
'Questo codice ordina i dati nella seconda
'colonna del foglio Dati ed elimina le righe che
'contengono dati duplicati.

Application.ScreenUpdating = False
Range("B4:B800").Select
Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Set currentCell = Worksheets("Dati").Range("B4")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.EntireRow.Delete
End If
Set currentCell = nextCell
Loop
Range("B4").Select

End Sub