UDF: IB·UNICOS alternativa a la función UNICOS para versiones de Excel inferiores a 2021

 La función IB·UNICOS  es una función personalizada de VBA que se ha creado con el propósito de brindar una alternativa similar de la función UNICOS para las versiones de Excel que no cuentan con dicha función. 

La función "IB·UNICOS" se utiliza para obtener una lista de valores únicos de una matriz y aplicar diferentes criterios de filtrado.

A continuación se presenta una descripción de los parámetros y la funcionalidad de esta función:

Sintaxis: 

La sintaxis de la función "IB·UNICOS" es la siguiente:

= IB·UNICOS(Matriz , Criterio)

Parámetros:

La función tiene dos parámetros:

Matriz : Es el rango de celdas que se va a analizar para encontrar valores únicos.

Criterio : Es un valor entero que determina el criterio para seleccionar los valores únicos. Los posibles valores son:
0: Devuelve todos los valores únicos encontrados en la matriz.
1: Devuelve solo los valores únicos que aparecen una vez en la matriz.
2: Devuelve solo los valores únicos que aparecen más de una vez en la matriz.

Limitaciones:

Para un correcto funcionamiento se debe seleccionar previamente un rango vertical de celdas igual al tamaño de datos del rango que se evaluara. Por ejemplo si se evaluara 15 datos, previamente se debe seleccionar 15 celdas de manera vertical a partir de la celda donde se devolverá el resultado antes de escribir la formula, una vez realizada la formulación se debe seleccionar la formula o posicionarse en la barra de formulas y presionar Ctrl + Shift + Enter

Para poder eliminar se debe seleccionar el rango de celdas que se selecciono previamente. Para eliminar sin problema se recomienda posicionarse en la primera celda del rango y presionar la combinación de teclas Ctrl + Shift + Tecla de dirección hacia abajo (⬇) o Ctrl + Shift + Barra de espacio para seleccionar toda la matriz y proceder a su eliminación o cambio de posición.

No aplica para formato de tabla es decir no reconocerá los nuevos datos que se ingresen en ella por lo cual se debe ajustar manualmente el nuevo rango de datos a evaluar.

Código: 

Function IB·UNICOS(Matriz As Range, Criterio As Integer) As Variant
    Dim D As Object, C As Range, V As Variant, i As Long, U() As Variant, T As Long
    Set D = CreateObject("Scripting.Dictionary")
    For Each C In Matriz
        V = C.Value
        If D.Exists(V) Then
            D(V) = D(V) + 1
        Else
            D.Add V, 1
        End If
    Next C
    T = Matriz.Rows.Count * Matriz.Columns.Count
    ReDim U(1 To T, 1 To 1)
    Select Case Criterio
        Case 0
            i = 1
            For Each V In D.Keys
                U(i, 1) = V
                i = i + 1
            Next V
        Case 1
            i = 1
            For Each V In D.Keys
                If D(V) = 1 Then
                    U(i, 1) = V
                    i = i + 1
                End If
            Next V
        Case 2
            i = 1
            For Each V In D.Keys
                If D(V) > 1 Then
                    U(i, 1) = V
                    i = i + 1
                End If
            Next V
    End Select
    For i = i To T
        U(i, 1) = ""
    Next i
    IB·UNICOS = U
End Function

Comentarios