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:

GENERAR CADENA DE CARACTERES ALFANUMERICOS ALEATORIOS SIN DUPLICADOS

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.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios

CONTAR REGISTROS ÚNICOS CON VARIOS CRITERIOS

Hola a todos:

Hoy voy a trabajar un poco con formulación clásica de Excel. En concreto vamos a contar registros únicos en función de varios criterios. Para ello he preparado una sencilla tabla con unos datos que nos van a servir de ejemplo:

CONTAR REGISTROS UNICOS CON VARIOS CRITERIOS

Imaginad que queremos contar los registros únicos de la columna C que dependan de “Dirección de Area 1 y que el criterio de la columna B sea mayor o igual a 1. Es decir:

CONTAR REGISTROS UNICOS CON VARIOS CRITERIOS1

Qué los registros únicos serán 3, las Subdirecciones Zona 1.1, 1.2 y 1.3

Para poder realizar esto con una fórmula vamos a utilizar la siguiente función matricial:

{=CONTAR(1/FRECUENCIA(SI(Hoja1!$A$2:$A$18="Dirección Area 1";SI(Hoja1!$B$2:$B$18>=1;COINCIDIR(Hoja1!$C$2:$C$18;Hoja1!$C$2:$C$18;0)));FILA($A$2:$A$18)-FILA(DESREF($A$2:$A$18;;;1;))+1))}

Como podéis ver, estamos usando varios fórmulas, CONTAR, FRECUENCIA, SI, COINCIDIR, FILA y DESREF.

El resultado es el siguiente:

CONTAR REGISTROS UNICOS CON VARIOS CRITERIOS2

Obviamente, la fórmula se puede modificar variando e incluyendo nuevos criterios, solo debéis realizar algunas pruebas.

Os recuerdo que las matrices se introducen: seleccionando la celda que contiene la fórmula, pulsando en F2 , seleccionamos la fórmula y luego presionamos CTRL + MAYUS + ENTRAR

Descarga el archivo de ejemplo pulsando en: CONTAR REGISTROS ÚNICOS CON VARIOS CRITERIOS

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

Aunque normalmente no tengo mucho tiempo, a veces entro en algunos foros de Excel y contesto algunas de las preguntas que realizan los lectores. Esto es muy positivo, siempre encuentras nuevas ideas para desarrollar y hechas una mano a otras personas.

La última consulta que respondí iba sobre la posibilidad de extraer registros únicos pero no de una columna sino de un rango de datos. Es decir, seleccionar un rango de celdas y extraer los registros únicos.

Esta tarea se puede hacer de varias formas, en esta ocasión lo implementaré con matrices en VBA y finalmente aplicaremos quitar duplicados.

Como siempre vamos a usar un ejemplo: voy a pegar varias columnas (tres, por ejemplo) sobre las que seleccionaré el rango sobre el que extraer la información:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS1

A continuación debemos pegar la macro que realizará el trabajo:

Sub EXTRAER_UNICOS()
'Definimos variables
Dim i As Long, fin As Long
Dim rng As Range, celda As Range
Dim final As Long
Dim matriz() As Variant
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Trabajamos con la hoja activa
With ActiveSheet
'Limpiamos datos en la columna E
.Columns("E:E").ClearContents
'Capturamos selección y contamos registros
i = 1
Set rng = Selection
fin = rng.Count
'Redimensionamos la matriz
ReDim matriz(1 To fin)
'Con un loop grabamos los datos de cada celda
'y los pasamos a la columna E

For Each celda In rng
matriz(i) = celda.Value
i = i + 1
Next celda
For i = LBound(matriz) To UBound(matriz)
.Cells(i, 5) = matriz(i)
Next i
'Eliminamos duplicados de la columna E
final = .Cells(Rows.Count, "E").End(xlUp).Row
'Si no hay datos en la columna E salimos del proceso
If final = 1 Then Exit Sub
.Range("E1:E" & final).RemoveDuplicates Columns:=1, Header:=xlNo
'Ordenamos los datos, centrados y ascendentes
With .Columns("E:E")
.Select
.HorizontalAlignment = xlCenter
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E1:E" & final), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("E1:E" & final)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("E1").Select
End With
Application.ScreenUpdating = True
End Sub

Ahora que ya tenemos la macro, solo tenemos que seleccionar los datos y pulsar en el botón de comando. El resultado lo pasará a la columna “E” o “5” (podéis especificar el destino que mejor se adapte a vuestras necesidades indicándolo en el código).

Y ya tenemos los datos:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS2

Dado que estamos trabajando con matrices, debéis tener en cuenta que tienen ciertos límites (por ejemplo, si seleccionamos toda la hoja, mostrará un error).

Y eso es todo por hoy, espero que os sea de utilidad. Por supuesto, en este ejemplo obtenemos los datos de una selección, pero se podría definir un rango perfectamente.

Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS