La navidad, esa época de dar y recibir amor por todos lados. ¿A quién podría no gustarle? Con sus casas adornadas y sus cero grados centígrados.
Una de las partes más importantes aquí en México es hacer el intercambio, una pequeña actividad en la cual una persona regala a otra un detalle y se repite el proceso hasta que todos tengan regalo. Lo malo es que hacer esa actividad tiene muchas aristas, como el hecho de quien debe programarla. Por fortuna para todos los organizadores Excel lo puede hacer por nosotros.
En el libro que puedes descargar aquí solo deberás depositar los nombres de las personas que participan y presionar el botón gris en la parte de arriba, con lo cual Excel hará un proceso aleatorio de entrega de regalos, con la única condición de que los nombres no se repitan dos veces en la lista (ósea que no se vale recibir doble regalo). Por cierto, no puede tocarte a ti mismo, Excel entiende muy bien la dinámica 😀
Aquí abajo te dejo el código si quieres conocer mas de cómo funciona bien descrito (o lo mejor que pude jeje).
Sub intercambio()
On Error GoTo line3
‘ Definimos variables
Dim rng as range, rng2 As Long, i As Integer, j As Integer, l As Integer
Dim nombres() As Variant
‘ Contamos el numero de personas inscritas
Range(«D9:E1000000»).ClearContents
rng = Application.WorksheetFunction.CountA(Range(«A9:A100000»))
rng2 = 0
l = 0
ReDim nombres(rng)
‘ depositamos los nombres en una variable
Range(«A9»).Select
For i = 1 To rng
nombres(i) = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Next i
‘ creamos la primera lista aleatoria
Do Until rng2 = rng
line1:
Randomize (0)
i = Int((rng * Rnd) + 1)
rng2 = Application.WorksheetFunction.CountA(Range(«D8:D100000»))
‘ comprueba que no se repitan los nombres
For j = 1 To rng2
If nombres(i) = Range(«D8»).Offset(j, 0).Value Then GoTo line1
Next j
If Range(«D8»).Offset(1, 0).Value <> «» Then
Range(«D8»).End(xlDown).Offset(1, 0).Value = nombres(i)
Else
Range(«D9»).Value = nombres(i)
End If
Loop
‘ creamos la segunda lista aleatoria
rng2 = 0
Do Until rng2 = rng
line2:
Randomize (0)
i = Int((rng * Rnd) + 1)
rng2 = Application.WorksheetFunction.CountA(Range(«E8:e100000»))
‘ comprueba que el nombre no se repita ni abajo ni en la lista
For j = 1 To rng2
If nombres(i) = Range(«E8»).Offset(j, 0).Value Or nombres(i) = Range(«E8»).Offset(rng2, -1).Value Then
l = l + 1
‘ esta parte es ajustable, esta programada para 10000 intentos
If l = 10000 Then Exit Sub
GoTo line2
End If
Next j
If Range(«E8»).Offset(1, 0).Value <> «» Then
Range(«E8»).End(xlDown).Offset(1, 0).Value = nombres(i)
Else
Range(«E9»).Value = nombres(i)
End If
Loop
line3:
End Sub
¡Nos leemos luego!
