Macro para números aleatorios en Excel
Quiero sortear los días de la semana de Lunes a Viernes entre 7 personas y que los resultados se me guarden en una tabla. Como son 7 personas y 5 días, se van a repetir dos días. Al estar recalculando la operación de "sorteo" no quiero que se modifiquen los demás valores ya calculados en la tabla de registro (al dar clic o usar el mouse), intenté usar un botón con una macro pero aún así cuando uso el mouse se me modifica el resultado anterior.
1 Respuesta
H o l a:
Suponiendo que tienes a las 7 personas en las celdas A1 a G1, ejecuta la siguiente macro, cada vez que la ejecutes de pondrá los días aleatoriamente.
La macro:
Sub DiasAleatorios()
'Por.Dante Amor
Dim dias(1 To 5, 1 To 2)
n = 1
m = 0
Do While True
y = Evaluate("=RANDBETWEEN(1,5)")
If n = 8 Then Exit Do
If dias(y, 1) <> "" Then
If dias(y, 2) <> "" Then
Else
If m < 2 Then
dias(y, 2) = n
m = m + 1
n = n + 1
End If
End If
Else
dias(y, 1) = n
n = n + 1
End If
Loop
'
k = Range("A" & Rows.Count).End(xlUp).Row + 1
For i = 1 To 5
Cells(k, dias(i, 1)) = diasemana(i)
If dias(i, 2) <> "" Then
Cells(k, dias(i, 2)) = diasemana(i)
End If
Next
End Sub
'
Function diasemana(num)
'Por.Dante Amor
Select Case num
Case 1: diasemana = "LUNES"
Case 2: diasemana = "MARTES"
Case 3: diasemana = "MIERCOLES"
Case 4: diasemana = "JUEVES"
Case 5: diasemana = "VIERNES"
End Select
End Function‘
S a l u d o s . D a n t e A m o r
Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.
¡Gracias! Si es la idea de lo que buscaba =)
Dante, ¿si lo quisiera para 8 personas y además agregarle un "6to día" que sea la opción "No aplica" que le tengo que modificar? Gracias!
Si lo requiero modificar así para más o para menos personas que cambias son necesarios? Y si lo quiero mover de filas o columnas? Por ejemplo para que empiece en B2.. o en D2.. Muchas gracias!!!
H o l a:
Para cambiar el inicio de los resultados, modifica en la macro estas líneas:
'Para que empiece en una columna col = "D" ' 'Para que empiece en una fila K = 2
Te anexo la macro con las nuevas líneas:
Sub DiasAleatorios()
'Por.Dante Amor
Dim dias(1 To 5, 1 To 2)
n = 1
m = 0
Do While True
y = Evaluate("=RANDBETWEEN(1,5)")
If n = 8 Then Exit Do
If dias(y, 1) <> "" Then
If dias(y, 2) <> "" Then
Else
If m < 2 Then
dias(y, 2) = n
m = m + 1
n = n + 1
End If
End If
Else
dias(y, 1) = n
n = n + 1
End If
Loop
'
'Para que empiece en una columna
col = "D"
'
'Para que empiece en una fila
k = 2
'
ncol = Columns(col).Column - 1
'k = Range(col & Rows.Count).End(xlUp).Row + 1
For i = 1 To 5
Cells(k, dias(i, 1) + ncol) = diasemana(i)
If dias(i, 2) <> "" Then
Cells(k, dias(i, 2) + ncol) = diasemana(i)
End If
Next
End Sub
'
Function diasemana(num)
'Por.Dante Amor
Select Case num
Case 1: diasemana = "LUNES"
Case 2: diasemana = "MARTES"
Case 3: diasemana = "MIERCOLES"
Case 4: diasemana = "JUEVES"
Case 5: diasemana = "VIERNES"
End Select
End FunctionPara que acepte más días o más personas, crea una nueva pregunta, en el desarrollo de la pregunta especificas los cambios que deseas y escribe que va dirigida a Dante Amor.
S a l u d o s
