por Aunque normalmente no tengo mucho tiempo, a veces entro en algunos foros de Excel y contesto algunas de las preguntas que realizan los lectores. Esto es muy positivo, siempre encuentras nuevas ideas para desarrollar y hechas una mano a otras personas.
La última consulta que respondí iba sobre la posibilidad de extraer registros únicos pero no de una columna sino de un rango de datos. Es decir, seleccionar un rango de celdas y extraer los registros únicos.
Esta tarea se puede hacer de varias formas, en esta ocasión lo implementaré con matrices en VBA y finalmente aplicaremos quitar duplicados.
Como siempre vamos a usar un ejemplo: voy a pegar varias columnas (tres, por ejemplo) sobre las que seleccionaré el rango sobre el que extraer la información:
A continuación debemos pegar la macro que realizará el trabajo:
Sub EXTRAER_UNICOS()
'Definimos variables
Dim i As Long, fin As Long
Dim rng As Range, celda As Range
Dim final As Long
Dim matriz() As Variant
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Trabajamos con la hoja activa
With ActiveSheet
'Limpiamos datos en la columna E
.Columns("E:E").ClearContents
'Capturamos selección y contamos registros
i = 1
Set rng = Selection
fin = rng.Count
'Redimensionamos la matriz
ReDim matriz(1 To fin)
'Con un loop grabamos los datos de cada celda
'y los pasamos a la columna E
For Each celda In rng
matriz(i) = celda.Value
i = i + 1
Next celda
For i = LBound(matriz) To UBound(matriz)
.Cells(i, 5) = matriz(i)
Next i
'Eliminamos duplicados de la columna E
final = .Cells(Rows.Count, "E").End(xlUp).Row
'Si no hay datos en la columna E salimos del proceso
If final = 1 Then Exit Sub
.Range("E1:E" & final).RemoveDuplicates Columns:=1, Header:=xlNo
'Ordenamos los datos, centrados y ascendentes
With .Columns("E:E")
.Select
.HorizontalAlignment = xlCenter
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E1:E" & final), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("E1:E" & final)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("E1").Select
End With
Application.ScreenUpdating = True
End Sub
Ahora que ya tenemos la macro, solo tenemos que seleccionar los datos y pulsar en el botón de comando. El resultado lo pasará a la columna «E» o «5» (podéis especificar el destino que mejor se adapte a vuestras necesidades indicándolo en el código).
Y ya tenemos los datos:
Dado que estamos trabajando con matrices, debéis tener en cuenta que tienen ciertos límites (por ejemplo, si seleccionamos toda la hoja, mostrará un error).
Y eso es todo por hoy, espero que os sea de utilidad. Por supuesto, en este ejemplo obtenemos los datos de una selección, pero se podría definir un rango perfectamente.
Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS
Hola amigos, gracias por el aporte, me funciono a la perfección
Estupendo aporte. Una duda, qué parte del código he de cambiar, si quiero que los datos se copien a partir de la celda E2.
Muchísimas gracias.
Debes indicarlo en el bucle:
.Cells(i +1 , 5) = matriz(i)
Sumar un +1 y comenzará en E2, saludos.
Muchísimas gracias, Segu.
Saludos,
Miguel A.
Disculpa Segu, lo acabo de probar y me sigue copiando los datos a partir de E1
Además, selecciones lo que selecciones, el resultado siempre es el mismo: del 1 al 24; es decir, al ejecutar la macro siempre da como números repetidos del número 1 al 24, ordenados de menor a mayor; aunque en la selección no existan números repetidos.
Hola Miguel Ángel, perdona:
Modifica las siguientes líneas en las que se indica E1 por E2
.Sort.SortFields.Add Key:=Range(«E2:E» & final), _
.SetRange Range(«E2:E» & final)
Y en la que te comenté antes por:
.Cells(i + 2, 5) = matriz(i)
En la respuesta anterior te contesté por el móvil. Ahora lo he probado. La macro muestra números sin duplicados según lo que ordenes. No siempre muestra numeros del 1 al 24, depende el rango que selecciones.
Saludos
Realizadas las modificaciones que propones, efectivamente ahora copia a partir de la celda E2; pero me sigue copiando del 1 al 24, seleccione lo que seleccione. No lo entiendo, porque me dices que lo has comprobado y a ti te funciona correctamente. El archivo con el que trabajas es el mismo que el del ejemplo de la descarga?
En cualquier caso, muchas gracias por tus amables respuestas
Hola Miguel Ángel:
Sí, es el mismo ejemplo de la descarga, por ejemplo si seleccionas 5 numeros te salen del 1 al 24? Si seleccionas todos los números te salen todos menos el 3 y el 6 que no existen, el resto de duplicados desaparecen.
Y si seleccionas las celdas que quieras con repetidos te lo elimina y deja solo uno. Funciona correctamente.
Saludos.
Entendido, Segu; pero si lo que quisiera fuese que que de una selección de celdas cualquiera eliminara todos los repetidos que encuentre y en el listado no los incluyera, se podría hacer?
Ejemplo: Seleccionamos A2:C3, como el único número repetido de esta selección sería el 1, que en el listado resultante lo eliminase; con lo cual su resultado sería: 2, 15, 17 y 19. Se podría adaptar este código, para conseguir esto con cualquier selección?
Sí se podría, pero no sirve esta macro, hay que crear otro procedimiento distinto. En estos momentos tengo poco tiempo por estar con otras consultas, cuando puedo trato de resolverlo. Saludos.
Segu, gracies por el aporte tan lmpio y preciso, la he ulilizado con 7 col y 692 filas com 33 datos diferente y es instantanea