Extraer valores únicos de rangos discontinuos
domingo, mayo 19, 2013
Esta nota trata sobre cómo extraer valores únicos de rangos que contienen más de una columna o rangos discontinuos.
Excel tiene dos métodos incorporados para esta tarea. En Excel 2007-2013 ambos se encuentran en la pestaña Datos: Filtro Avanzado y Quitar duplicados
Filtro Avanzado nos permite hacerlo con relativa facilidad usando la posibilidad, como mostramos en este video:
Con Quitar duplicados la técnica es un poco más elaborada, ya que incluye copiar la lista a un rango apartado y allí extraer los duplicados (si estamos interesados en guardar la lista original)
Las limitaciones de estos métodos comienzan cuando queremos extraer valores únicos de rangos discontinuos o de rangos que contienen más de una columna.
Podemos hacerlo con un código relativamente sencillo, similar al que mostramos en la nota sobre listas desplegables dependientes publicada hace poco. Este código se basa en el objeto Collection. El código es el siguiente
Sub extraerUnicos_Hoja()
'extraer valores unicos de rangos de varias columnas o no continuos
'Jorge Dunkelman - JLD Excel Blog, mayo 2013
Dim collUnicos As New Collection
Dim vcollItem As Variant
Dim rngCell As Range, rngDatos As Range, rngLista As Range
Dim lCounter As Long
Set rngDatos = Application.InputBox(prompt:="Seleccione rango/s con datos", Type:=8)
Set rngLista = Application.InputBox(prompt:="Seleccione la primera celda de la lista", Type:=8)
On Error Resume Next
For Each rngCell In rngDatos
collUnicos.Add rngCell, rngCell
Next rngCell
On Error GoTo 0
lCounter = 0
For Each vcollItem In collUnicos
rngLista.Offset(lCounter, 0) = CStr(vcollItem)
lCounter = lCounter + 1
Next vcollItem
End Sub
Con este código definimos el rango que contiene los datos (que puede contener varias columnas o ser discontinuo, pero todos los datos deben estar en la misma hoja), definimos la celda desde donde queremos empezar a pegar la lista de registros únicos y el código la genera.
Por ejemplo, en esta matriz de 6 filas por tres columnas (18 valores) donde hay 5 valores únicos (a, b, c, d y e)
Para que este código sea realmente útil debemos agregar algunas líneas para manejar errores que pueden ocurrir durante el proceso (por ejemplo, si el usuario selecciona un rango de datos con una sola celda o si aprieta el botón Cancel del InputBox). El código completo es el siguiente
Sub extraerUnicos_Hoja()
'extraer valores unicos de rangos de varias columnas o no continuos
'Jorge Dunkelman - JLD Excel Blog, mayo 2013
Dim collUnicos As New Collection
Dim vcollItem As Variant
Dim rngCell As Range, rngDatos As Range, rngLista As Range
Dim lCounter As Long
On Error GoTo errCancel 'si se aprieta Cancel
Set rngDatos = Application.InputBox(prompt:="Seleccione rango/s con datos", Type:=8)
If rngDatos.Count < 2 Then
MsgBox "Debe seleccionar un rango con mas de dos celda", vbCritical
Exit Sub
End If
Set rngLista = Application.InputBox(prompt:="Seleccione la primera celda de la lista", Type:=8)
If rngLista.Count <> 1 Then
MsgBox "Seleccione solamente una celda", vbCritical
Exit Sub
End If
On Error Resume Next
For Each rngCell In rngDatos
collUnicos.Add rngCell, rngCell
Next rngCell
On Error GoTo 0
lCounter = 0
For Each vcollItem In collUnicos
rngLista.Offset(lCounter, 0) = CStr(vcollItem)
lCounter = lCounter + 1
Next vcollItem
Exit Sub
errCancel:
Exit Sub
End Sub Seguir leyendo...
