GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

Hola todos!

Hace unos meses publiqué un post acerca de la generación de números aleatorios sin duplicados:  OBTENER NÚMEROS ALEATORIOS SIN DUPLICADOS

El código funciona perfectamente y muchos lectores lo han descargado para usarlo en sus aplicaciones. Sin embargo, ayer un usuario me consultaba si podría modificarlo para generar una cadena alfanumérica aleatoria sin duplicados.

La respuesta es que sí, veamos el código y las modificaciones realizadas:

Option Explicit
Sub OBTENER_CADENA_ALEATORIOS_UNICOS()
'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, fin As Integer
Dim nLetU As String, nLetL As String, nItem As Variant, nCombo As Integer
With Sheets("Hoja1")
'eliminamos información generada en la consulta anterior.
fin = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Rows.Count
.Range("A2:A" & 2 + fin).ClearContents
'Creamos objeto diccionario
Set oDic = CreateObject("scripting.dictionary")
'Ejecutamos loop hasta el total de números y letras que queremos obtener
Do Until j = .Cells(2, 6)
'generamos aleatorios entre 1 y 50
nNum = Application.WorksheetFunction.RandBetween(.Cells(4, 6), .Cells(4, 7))
'generamos aleatorio de letras mayúsculas
nLetU = Chr((Application.WorksheetFunction.RandBetween(65, 90)))
'generamos aleatorio de letras minúsculas
nLetL = LCase(Chr((Application.WorksheetFunction.RandBetween(65, 90))))
'determinamos aleatoriamente qué elemento seleccionamos para pasar a la cadena
nCombo = Application.WorksheetFunction.RandBetween(1, 3)
If nCombo = 1 Then
nItem = nNum
ElseIf nCombo = 2 Then
nItem = nLetU
ElseIf nCombo = 3 Then
nItem = nLetL
End If
'componemos string con los números y letras que vamos generando
Micelda = Micelda & " " & nItem
matrix1 = Split(Micelda, " ")
'Eliminamos números y letras 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 y letras aleatorios únicos que vamos generando
j = UBound(matrix2) + 1
Loop
'Pasamos los datos a la hoja1
matrix2 = Split(sCadena, " ")
For j = 0 To UBound(matrix2)
.Cells(j + 2, 1) = matrix2(j)
Next j
End With
'Vaciamos variable de objeto
Set oDic = Nothing
End Sub

Para poder generar aleatorios de letras, necesitamos recurrir a los caracteres ASCII, en concreto vamos a utilizar los que van desde el 65 al 90, que comprenden el abecedario en mayúsculas. Luego solo tenemos que introducir la función aleatorio.entre y tendremos una variable que generará una letra de forma aleatoria cada vez que se ejecute el código:

nLetU = Chr((Application.WorksheetFunction.RandBetween(65, 90)))

Para realizar lo mismo en minúsculas, solo tenemos que transformar esta información con LCase:

nLetL = LCase(Chr((Application.WorksheetFunction.RandBetween(65, 90))))

Luego, con un pequeño condicional y otra variable aleatoria entre 1 y 3, iremos componiendo nuestra cadena alfanumérica aleatoriamente, y con el objeto dictionary eliminaremos los duplicados.

El resultado, por ejemplo, generando una cadena de 25 caracteres con números comprendidos del 1 al 9, sería este:

Como podéis observar la información se obtiene perfectamente. Aunque es obvio, lo comentaré, las letras mayúsculas y minúsculas se tratan como si fuesen caracteres diferentes, por ello pueden existir tanto una «M» mayúscula como una «m» minúscula.

Y eso es todo, espero que resulte de utilidad : )

Descarga el archivo de ejemplo pulsando en: GENERAR CADENA DE CARACTERES ALFANUMÉRICOS ALEATORIOS SIN DUPLICADOS

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



¡¡Muchas gracias!!