Extraer elementos aleatoriamente sin repetición

Puede descargar el archivo extrae_aleatoriamente.xlsm

Disponemos de una columna con datos y queremos extraer en otra columna una serie de datos elegidos de forma aleatoria.

Pasos a seguir

1. En la celda amarilla (E4) escribimos cuantos datos queremos extraer. El número puede variar entre 1 y 20. No olvidar pulsar ENTER después de introducir el número.
2. Pulsamos sobre el botón que lanza la macro: donde pone Extraer en rojo.
3. Con esto ya tendremos una extracción. Pulsando el botón de la macro podremos extraer otra nueva muestra aleatoria.

Código

El código contiene dos partes.

• Para manejar la celda amarilla hemos creado un código que maneja un evento. Además la celda amarilla está tratada con Datos/Validación para que únicamente admita números enteros entre 1 y 20.

 Private Sub Worksheet_Change(ByVal Target As Range)  
 Worksheets("Hoja1").Activate  
 If Not Intersect(Target, Range("E4")) Is Nothing Then  
   Target.Interior.ColorIndex = 45  
   Range("E7:G26").ClearContents  
   For i = 1 To Target  
     Cells(i + 6, 5) = i  
   Next i  
 End If  
 End Sub  

• Para la macro que se lanza con el botón hemos creado un procedimiento en VBA que se basa en la idea siguiente. Metemos la columna con los datos de entrada en la matriz A(). Creamos la matriz B() con un listado de los números desde el 1 hasta el 20, ordenados. Nos metemos en un bucle For que recorre la matriz B() comenzando por el final, desde la posición 20 hasta la posición 2. Por cada ciclo del bucle va permutando el valor de esa posición, inicialmente B(20), luego B(19), y así hasta llegar a la última con la que se trabaja que es B(2), con alguno de los valores previos elegidos aleatoriamente. Por ejemplo, el valor de B(20) se permuta con B(7), luego B(19) se permutará con B(15), etc., hasta llegar a B(2) cuyo valor se permutará con B(1). Para hacer estas permutaciones necesitaremos la variable auxiliar aux.

Es una forma curiosa de barajar las cartas de una baraja, y nos ha permitido crear un algoritmo eficiente. Al final del bucle For obtendremos una matriz B() perfectamente aleatorizada. En el último bucle For lo que hacemos es mostrar en la columna G los valores extraidos simplemente consultando las posiciones correspondientes de la matriz A().

 Option Explicit  
 Option Base 1  
 Sub extrae()  
 Dim num_datos As Long  
 Dim num_extraidos As Long  
 Dim rango_origen As Range  
 Dim A()  
 Dim B() As Long          'contiene los números del 1 hasta num_datos, inicialmente ordenados  
 Dim i As Long, r As Long, aux  
 num_extraidos = [E4]  
 Set rango_origen = Range("C7:C26") '<-- El usuario debe cambiar este valor por el de su caso  
 num_datos = rango_origen.Count  
 ReDim B(num_datos)  
 For i = 1 To num_datos  
   B(i) = i            'asignamos a B() los números del 1 hasta num_datos  
 Next i  
 A = rango_origen  
 Randomize  
 'vamos a desordenar los valores de la matriz B()  
 For i = num_datos To 2 Step -1   'i varia disminuye desde n hasta 2  
   aux = B(i)           'la variable auxiliar captura el valor último, el i-ésimo  
   r = Int(RND() * i) + 1     'r es un aleatorio entero entre 1 e i  
   B(i) = B(r)          'el valor i-ésimo será el que tenía A(r,1) que es previo  
   B(r) = aux           'para finalizar la permuta, el valor A(r,1) toma el valor que teníamos guardado en la variable auxiliar  
 Next i  
 For i = 1 To num_extraidos  
   Cells(i + 6, 6) = B(i)  
   Cells(i + 6, 7) = A(B(i), 1)  
 Next i  
 Range("E4").Interior.ColorIndex = 36  
 End Sub