Obtener los elementos únicos de una lista

Una tarea común es obtener los elementos únicos de una lista. La siguiente macro permite realizarlo:

Sub elementosunicos()

Dim celda As Range
Dim unicos As Collection
Dim sh As Worksheet
Dim i As Long

'nos aseguramos que la seleccion sea un rango
If TypeName(Selection) = "Range" Then

'inicializamos la coleccion
Set colUnique = New Collection

'loop en todas las celdas y agregarlas a la coleccion
For Each celda In Selection.Cells

'si el elemento existe, se genera un error
, ignorarlo
On Error Resume Next

'una coleccion solo agrega elementos no repetidos

unicos.Add celda.Value, CStr(celda.Value)
On Error GoTo 0
Next celda

'agregar hoja para la lista
Set sh = ActiveWorkbook.Worksheets.Add

'escribir los datos unicos
For i = 1 To unicos.Count
sh.Range("A1").Offset(i, 0).Value = unicos(i)
Next i

'ordenar
sh.Range(sh.Range("A2"), sh.Range("A2").End(xlDown)) _
.Sort sh.Range("A2"), xlAscending, , , , , , xlNo

End If

End Sub

Otras alternativas son generar una tabla dinámica y agregar el campo correspondiente al área de filas, o bién, utilizar el filtro avanzado. El análisis que hagamos del modelo nos dirá cuál método es el mejor.

0 comentarios:

Publicar un comentario