Hola a todos!.

Qué tal estáis? supongo que disfrutando de los últimos días del año!.

Hoy os voy a dejar un código para crear una UDF que sea capaz de extraer los registros únicos de un rango determinado. Aunque ya os había propuesto una macro parecida aquí: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

En este código lo vamos a hacer con una función y utilizando un método distinto. La principal diferencia es que el resultado de la función lo vamos a llevar a una celda y no de nuevo a un rango.

Veamos el código:

Option Explicit
Function F_UNICOS(ByVal Target As Range, delimitador As String)
'Declaramos variables
Dim oDic As Object
Dim Micelda As String, matrix1 As Variant
Dim i As Long, Unico As String, celda As Variant
With Sheets("Hoja1")
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Componemos string con el rango seleccionado
For Each celda In Target
If celda <> vbNullString Then
Micelda = Micelda & delimitador & celda
matrix1 = Split(Micelda, delimitador)
End If
Next celda
'Eliminamos números o letras repetidos
For i = 0 To UBound(matrix1)
If Not oDic.Exists(matrix1(i)) Then oDic.Add matrix1(i), matrix1(i)
Next i
'Extraemos registros únicos con el delimitar elegido
Unico = Mid(Join(oDic.keys, delimitador), Len(delimitador) + 1, Len(Join(oDic.keys, delimitador)))
F_UNICOS = Unico
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Function

¿Que resultado conseguimos con este código?, pues este:

Primero seleccionamos el rango e indicamos el delimitador que queremos entre los registros que hemos extraído:

FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE UN RANGO

El resultado es este:

FUNCIÓN PARA EXTRAER REGISTROS ÚNICOS DE UN RANGO_1.jpg

Como podéis observar, la función nos ofrece el resultado esperado y en un tiempo razonable. Si necesitáramos pasar los datos a un rango os recomiendo la funcionalidad texto en columnas, en la función no se puede realizar (solo aplicando la función matricialmente, y para eso lo podemos lograr con una fórmula).

Y eso es todo, espero que os resulte de utilidad.

Descarga el archivo de ejemplo pulsando en

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies

Comparte este post