Hola a todos!.

Hace algún tiempo programé una macro para obtener números aleatorios únicos (sin duplicados): OBTENER NÚMEROS ALEATORIOS SIN DUPLICADOS

Como en casi todos los ejemplos de programación en esta web utilizo procedimientos «sub» que se ejecutan con un botón, y revisando esta macro creo que sería muy interesante transformarlo a una UDF o Función definida por el usuario.

La ventaja es que se podría ejecutan en cualquier lugar del libro sin necesidad de estar modificando la programación. Es decir, será una fórmula más.

El nombre que le voy a poner será NUM_ALEATORIOS_UNICOS( ) y el código es este:

Option Explicit
Function NUM_ALEATORIOS_UNICOS(ByVal nLARGO, nINI, nFIN)
    'Declaramos variables
    Dim oDic        As Object, palabra As Variant
    Dim Micelda     As String, matrix1 As Variant, matrix2 As Variant
    Dim sCadena     As String, i As Integer, unicos As String
    Dim j           As Integer, nNum As Double
    With ActiveSheet
        'Creamos objeto diccionario
        Set oDic = CreateObject("scripting.dictionary")
        'Ejecutamos loop hasta el total de números que queremos obtener
        Do Until j = nLARGO
            'generamos aleatorios entre el rango indicado
            nNum = Application.WorksheetFunction.RandBetween(nINI, nFIN)
            'componemos string con los números que vamos generando
            Micelda = Micelda & " " & nNum
            matrix1 = Split(Micelda, " ")
            'Eliminamos numeros repetidos
            For i = 0 To UBound(matrix1)
                If Not oDic.Exists(matrix1(i)) Then oDic.Add matrix1(i), matrix1(i)
            Next i
            'Creamos una nueva cadena sin duplicados y seguimos el loop
            unicos = Join(oDic.Keys, " ")
            sCadena = Trim(unicos)
            matrix2 = Split(sCadena, " ")
            'contamos los números aleatorios únicos que vamos generando
            j = UBound(matrix2) + 1
        Loop
        'Pasamos los datos a la función
        matrix2 = Split(sCadena, " ")
        ReDim miArray(0 To UBound(matrix2))
        For j = 0 To UBound(matrix2)
            miArray(j) = matrix2(j)
        Next j
        NUM_ALEATORIOS_UNICOS = Application.Transpose(miArray)
    End With
    'Vaciamos variable de objeto
    Set oDic = Nothing
End Function

El resultado es el siguiente:

Como podéis observar en el ejemplo he consultado 10 números únicos aleatorios entre el 1 y el 30.

Este procedimiento en versiones de Excel que no cuentan aún con la actualización que contiene las nuevas fórmulas de matriz dinámica se mostrará de manera distinta, es decir será necesario seleccionar el rango del resultado, seleccionar la fórmula y aplicar CTRL + MAYUS + ENTRAR.

Por otra parte, al igual que el resto de funciones de matriz dinámica, cuando hayamos guardado el libro y vuelto a abrirlo, para modificar estas fórmulas es necesario también seleccionar la fórmula y el rango y aplicar CTRL + MAYUS + ENTRAR, de lo contrario, como sabéis, no podremos modificar una matricial.

Y espero que esta función sea de vuestra 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