viernes, 21 de septiembre de 2012

Aleatorios sin repetición con macros en Excel.

En la anterior entrada del blog explicaba como conseguir cierta cantidad de números aleatorios sin repetición para un intervalo de valores dado.
En el ejemplo que plantearé obtendremos 20 números aleatorios sin repetición de un rango de valores entre 1 y 100.
En esta ocasión aplicaremos una macro que nos lleva a ese mismo resultado, aleatorios sin repetición; el mecanismo que emplearemos será el de crear una Collection, generando números aleatorios hasta alcanzar (en el ejemplo que describo) 20 elementos de la colección, es decir, 20 números aleatorios no repetidos.

Otra de las instrucciones de VBA que usaré es el DO UNTIL...LOOP, que permite incrementar el tamaño de nuestra Collection hasta 20.

El código que insertaremos en un Módulo del Explorador de proyectos del Editor de VBA, formando nuestra macro de Excel:

Sub AleatoriosNoRepetidos()
Dim i As Integer

'generamos la coleccion
Set unicos = New Collection

x = 1 'núm inicial del rango de valores
y = 100 'núm final del rango de valores
z = 20 'numero de elementos no repetidos que queremos

'Inicializamos el generador de números aleatorios
Randomize

'loop hasta conseguir Z elementos de la Collection (20 elementos)
Do Until unicos.Count = z
    'generamos nuevos aleatorios entre x e y (entre 1 y 100)
    ale = Int((y - x + 1) * Rnd + x)
    'cuando encuentre un item repetido, daría un error
    'que salvamos con la instrucción On Error Resume Next
    On Error Resume Next
    'por tanto, nuestra coleccion solo agrega elementos no repetidos
    'objeto.Add item, key, before, after
    'ocurre un error si una key especificada duplica la key de un miembro existente de la colección
    unicos.Add ale, CStr(ale)
    On Error GoTo 0
Loop

'escribir los datos unicos en la Hoja de cálculo
For i = 1 To unicos.Count
    Sheets("Macro").Range("B2").Offset(i - 1, 0).Value = unicos(i)
Next i

End Sub


Si asginamos la macro a un botón en nuestra Hoja de Excel, y ejecutamos la macro, obtendremos en el rango B2:B21:

Aleatorios sin repetición con macros en Excel.


He añadido en C2:C21 un CONTAR.SI para comprobar que efectivamente no hay valores repetidos.
Podemos comprobar como hemos conseguido 20 números aleatorios entre 1 y 100 sin repetición.

6 comentarios:

  1. y si quiero de una lista especifica?

    ResponderEliminar
    Respuestas
    1. Hola Christian, que tal estás?
      un placer saludarte igualmente.

      si es un listado concreto (fechas, texto, etc), siempre podrás asociar un número, un Id, a cada elemento.. y luego trabajar sobre éstos valores numéricos.. de igual forma que la descrita arriba.
      Un cordial saludo

      Eliminar
  2. Hola no me da la macro, necesito hacer unas tablas de bingo, ellas tienen 5 columnas con 5 posibilidades de generar números, del 1 al 15, del 16 al 30, del 31 al 45, de 46 al 60 y del 61 al 75.

    Podrías colaborarme, gracias

    ResponderEliminar
    Respuestas
    1. Hola Carlos,
      quizá te resulte más sencillo aplicar y situar las celdas en el orden que quieras empleando lo descrito en
      http://excelforo.blogspot.com.es/2012/09/aleatorios-sin-repeticion-en-excel-sin.html.

      Si deseas emplear la macro tendrías que lanzar cinco procesos, uno por cada línea, modificando la macro descrita, cambiando las líneas 7,8 y 9 por los valores que desees, por ejemplo para la primera línea del cartón:
      x=1
      y=15
      z=5
      luego la línea 20 sería:
      Sheets("Macro").Range("B2").Offset(0,i + 1).Value = unicos(i)

      e igual para las otras líneas del cartón el 16 al 30, del 31 al 45, de 46 al 60 y del 61 al 75.

      Saludos

      Eliminar
  3. Saludos, como quedaría la macro para hacer 6 tablas en una hoja de excel?, gracias de antemano

    ResponderEliminar
    Respuestas
    1. Hola
      habría que determinar primero la distribución sobre la hoja de las seis tablas...
      Pero básicamente habría que posicionar el inicio de cada tabla mediante variables o incluso de manera fija (puesto que siempre serían seis..)

      Saludos

      Eliminar