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
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