Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Crear valores aleatorios y escribirlos en celda.

SebastianFelipe

Recommended Posts

SebastianFelipe Principiante

SebastianFelipe

publicado
publicado

Estimada Comunidad: Recurro a ustedes esperando que se encuentren muy bien: Les escribo para hacer consulta sobre como podría generar números aleatorios con VBA, los cuales se vayan enlistando a medida que vayan saliendo. Mi idea es simular un sorteo aleatorio de las personas que se deberán encargar de la limpieza de un lugar y que, una vez les haya tocado limpiar, quede registrado en una hoja excel el día que les ha tocado. Además, lo ideal es que no se repitan hasta que todos hayan pasado por 1 día de limpieza. De lo anterior desprendo que lo necesario es lo siguiente:

1) Generar 3 números aleatorios que no se repitan entre sí.

2) Verificar si ya han limpiado anteriormente (en el registro). Si ya limpiaron, volver a generar aleatorios. Si no han tirado. Registrar y terminar proceso.

De esta manera podría garantizar que tres personas serán generadas aleatoriamente y se verificará si ya han salido sorteados anteriormente.

Mi trabajo hasta el momento es el siguiente:

 

'GENERAR NÚMERO ALEATORIO.

'(Módulo NroAleatorio)

Option Explicit

Dim min As Integer
Dim max As Integer

Private Function Aleatorio(min As Integer, max As Integer) As Integer
Aleatorio = Int((min - max + 1) * Rnd + max)
End Function

Public Function AleatorioSP() As Integer
DefineValores
AleatorioSP = Int((min - max + 1) * Rnd + max)

End Function

Private Sub DefineValores()
min = Hoja1.Range("C30")
max = Hoja1.Cells(31, 3)
End Sub
 

Option Explicit

Sub Loteria()

Dim Nros As String
Dim Temp As Integer
Dim i As Integer
'
For i = 1 To Hoja1.Range("C32")
'For i = 1 To 3
'Temp = NroAleatorio.AleatorioCP(1, 45)
Temp = NroAleatorio.AleatorioSP

If InStr(1, Nros, CStr(Temp)) = 0 Then
    Nros = Nros & ", " & CStr(Temp)
Else

i = i - 1

End If

Next
MsgBox "Las personas que deberán ser parte de la comisión de limpieza la semana X son los asociados al numero " & Nros

Dim matriz(30) As String

matriz(1) = "July"
matriz(2) = "Patricia"
matriz(3) = "Jessica"
matriz(4) = "Marcela"
matriz(5) = "Javiera"
matriz(6) = "Felipe"
matriz(7) = "Janet"
matriz(8) = "Jordan"
matriz(9) = "Carol"
matriz(10) = "David"
matriz(11) = "Alejandra"
matriz(12) = "Jessica"
matriz(13) = "Karem"
matriz(14) = "Karen"
matriz(15) = "Monica"
matriz(16) = "Jaime"
matriz(17) = "Gustavo"
matriz(18) = "Catherine"
matriz(19) = "Moira"
matriz(20) = "Andrés"
matriz(21) = "Javier"
matriz(22) = "Francisco"
matriz(23) = "Matías"
matriz(24) = "Mirtha"
matriz(25) = "Sandra"
matriz(26) = "Cristian"
matriz(27) = "Alfonso"
matriz(28) = "Konny"
matriz(29) = "Graciela"
matriz(30) = "Carolina"
matriz(31) = "Tiare"
matriz(32) = "Yasna"
matriz(33) = "Miguel"
matriz(34) = "Jorge"
matriz(35) = "Pedro"
matriz(36) = "Patricio"
matriz(37) = "Camilo"

MsgBox "La persona asociada al número es " & matriz(Nros)

End Sub
 

Lo interesante es que hasta el momento genero un número aleatorio pero no puedo compilar al no poder mezclar el valor generado aleatoriamente con la matriz generada.

Dudas: Esta bien realizado?

Consultas a vosotros: Si logro compilar vinculando la matriz a los números generados, como puedo ir escribiendo los números generados aleatoriamente en un registro (Hoja Registro) y luego ir verificando en ella si ya ha salido anteriormente el número?

 

Agradezco muchisimo su ayuda y espero que todos se encuentren sanos y vigorosos en estos días dificiles.

 

Saludos desde Chile.

PS: Adjunto mi archivo.

 

 

 

aleatorio.xlsm

Haplox Asiduo a Ayuda Excel

Haplox

publicado
publicado

@SebastianFelipe , solo una cosa ¿Se debe repetir el sorteo si solo alguno de los 3 ya ha limpiado, o si lo han hecho los 3? Me refiero a que si sacas un aleatorio, y no ha limpiado, se le asigne.

Al sacar otro aleatorio y ese sí ha limpiado, se saca otro aleatorio hasta encontrar uno QUE NO ha limpiado, etc. Así hasta completar los 3

SebastianFelipe Principiante

SebastianFelipe

publicado
  • Autor
publicado

Buenas tardes @Haplox, gracias por tu respuesta. Creo que la manera optima sería que si se saca un aleatorio y este no ha limpiado, se le asigne la labor; en caso de ya haber participado, dejar el valor nulo y "devolverlo" o "anularlo" para buscar un nuevo participante que cumpla los requisitos.

Efectivamente tal cual tu dices. Te agradezco mucho la pregunta para permitirme aclararlo.

SebastianFelipe Principiante

SebastianFelipe

publicado
  • Autor
publicado

Buenas tardes @Haplox, he estado trabajando en tu solución y es lo que estoy buscando, GRACIAS!. 

Lo que he notado, es que al iterar un par de veces, los valores se me han comenzado a repetir:

image.png.bd40804bc819e4d1c58db3f201302690.pngMe pregunto, se deberá porque en un mismo día de limpieza no debería haber más de una iteración? Faltará que, una vez identificada una iteración, el código identifique los que ya han limpiado para no seleccionarlos nuevamente?

Por cierto, cuando limpio el registro de personas, arroja un error y al finalizar, solo entrega un dato (adjunto screenshot)

image.thumb.png.b1e71e08ebb862c69135535d2a5da438.png

Sobre lo anterior, Al depurar indica que está fallando la siguiente linea:

Selection.AutoFill Destination:=Range("A2:A" & ufR + 1), Type:=xlFillSeries ' (Será que Falta una condición para cuando está vacía?)

 

Solo eso observé de tu propuesta, de la cual estoy enormemente agradecido.

Te quería consultar, en casos de que una persona que haya sido elegida para limpieza no asistiera por X motivo, que tan dificil sería considerar un MsgBox que consulte si los números aleatorios satisfacen las necesidades seguir con el proceso, y si por alguna razón que el administrador considere pertinente se vuelva a hacer la iteración?

Un estilo de: 

If MsgBox("Está seguro que desea fijar la siguiente comisión?", vbYesNo + vbQuestion) = vbYes Then
GoTo Nuevo
End if
 

Completamente agradecido de tu ayuda, 

Felipe.

Haplox Asiduo a Ayuda Excel

Haplox

publicado
publicado

@SebastianFelipe te dejo una nueva versión. Estudia el código porque he cambiado varias cosas:

  • Te deja elegir si quieres registrar la terna
  • Calcula si alguno de la terna ya ha limpiado, modificando la terna
  • Te deja elegir si quieres o no la nueva terna creada
  • Si ya han limpiado las 36 personas (tenías una duplicada...) te obliga a limpiar la lista, si no no funcionaría la macro

No me ha dado tiempo a probarlo mucho. Míralo y comenta

Copia de aleatorio.xlsm

SebastianFelipe Principiante

SebastianFelipe

publicado
  • Autor
publicado

Estimado @Haplox, estudiando el código que me has presentado, he notado lo siguiente:

  • Sólo al hacer la primera iteración, se permite obtener más de una vez un número aleatorio (la probabilidad es de un 0,1% pero
  • me percaté porque me pasó). Si cancelas la comisión tal cual lo hago en el video, se puede corroborar.

  • Lo segundo ocurre cuando se intenta agregar un grupo de personas y ya se encuentra alguien en el registro, te preguntará si quieres agregar a una persona nueva. Sin embargo, termina por agregar cuatro personas (es un poco dificil de explicar por lo que te subo el siguiente video a youtube (pesaba mucho para adjuntar acá)

Finalmente si sigues con la iteración hasta superar las 37  ocaciones, termina por crashearse el excel. Te adjunto un print en donde podrás notar que se repiten cada vez que intenta suplantar una nueva persona que ya se encuentra en el registro.

image.thumb.png.8de501e81c08c49d014a8a8dc58c8cd5.png

Eso serían las dos cosas que noté. por lo demás, te agradezco mucho el tiempo que te has tomado y la gentileza de responder todas mis dudas que no soy capaz de resolver por mi mismo.

Te deseo muy buen término se semana.

Atentamente,

Felipe.

 

 

 

 

Haplox Asiduo a Ayuda Excel

Haplox

publicado
publicado
Hace 12 horas, SebastianFelipe dijo:

Eso serían las dos cosas que noté. por lo demás, te agradezco mucho el tiempo que te has tomado y la gentileza de responder todas mis dudas que no soy capaz de resolver por mi mismo.

Estoy en ello...

SebastianFelipe Principiante

SebastianFelipe

publicado
  • Autor
publicado

Estimados @Antoni y @Haplox, estoy muy agradecidos de ambos por sus propuestas que me han brindado, ambas son brillantes. 

 

En el caso de la propuesta de @Haplox, estoy muy agradecido por darte el tiempo de comentar el código, me lo he estudiado y no solo me ha funcionado a la perfección, si no que he aprendido un poco más de como van los códigos que me has dejado.

 

En el caso de @Antoni, me ha gustado mucho la presentación del archivo con ListBox y TextBox, queda bastante amigable para rellenar. Al no ser algo que tenía en mente, me ha impresionado mucho.

 

Agradecido de ambos, doy por cerrado el tema con dos excelentes propuestas. Una de ellas comentada para quienes lo requieran y otra opción con el implemento de useforms.

 

Gracias!

 

PS: y que pena que no se puedan marcar ambas respuestas como mejor respuesta.

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.