Saltar al contenido

Macro que compruebe fecha en un rango y genere número aleatorio en otra columna


Recommended Posts

publicado

Estimados amigos, acudo a ustedes solicitando por favor su ayuda con una macro, la cual necesito que compruebe la fecha de nacimiento y genere un número aleatorio que no se repita ni en próximas generaciones de aleatorios hasta que se agoten los números y vuelva nuevamente el ciclo, es decir:

Que compruebe en el rango (“C6:C20”) la fecha de nacimiento y si:

=< 30 años genere en la columna (“A”) un número aleatorio del 1 al 100 que no se repita

=>31 hasta los 40 genere en la columna (“A”) un número aleatorio del 101 al 200 que no se repita

Y mayores de 40 genere en la columna (“A”) un número aleatorio del 201 al 300 que no se repita

Una vez que no haya más números que coger que vuelva el ciclo

Tengo una macro que me genera los aleatorios y funciona perfectamente pero no se como hacer que me genere con condición:

Sub AleatoriosNoRepetidos()
Dim i As Integer

'generamos la coleccion
Set unicos = New Collection

x = 1 'núm inicial del rango de valores
y = 300 'núm final del rango de valores
Z = 10 '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("Bitacora").Range("D6").Offset(i - 1, 0).value = unicos(i)
Next i

End Sub[/CODE]

Muchas gracias por su ayuda.

Saludos.

publicado

Estimado Riddle, muchas gracias por tu ayuda.

Vi tu archivo y te comento que se acerca a lo que necesito, pero lo que necesito es que detecte la edad con la fecha de nacimiento es decir:

25/01/1981, la macro debe ver cuantos años tiene la persona y según eso poner el número aleatorio que no deben repetirse, ya que en la macro que me ayudaste los números se repiten al correrla nuevamente y necesito que no se repitan por lo menos hasta terminar del 1 al 100, del 101 al 200 y del 201 al 300, es decir cuando los 100 números de cada rango se hayan terminado que recién repita nuevamente los números.

Muchas gracias por tu ayuda

publicado

@[uSER=143023]Riddle[/uSER] Adjunto el archivo con un cambio que le hice a tu macro, ahora solo me falta que no se repitan los números al generar nuevos aleatorios, no se si es posible ponerle una especie de base de números generados en otra hoja para que al generar nuevos números compruebe si ya están en la base de generados anteriormente para no ponerlos??

Saludos.

Libro1.rar

Archivado

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

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

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


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Archivos

  • Estadísticas de descargas

    • Archivos
      187
    • Comentarios
      97
    • Revisiones
      29

    Más información sobre "Un juego del Rabino en Excel"
    Última descarga
    Por pegones1

    2    1

  • Crear macros Excel

  • Mensajes

    • Buenos días,  espero se encuentren bien de salud compañeros, Favor me podrían ayuda con lo siguientes como se podría hacer cuando tengo una tabla dinámica que  amedida que se aumente las columnas fechas con data un formula que se coloco al final busque o analice siempre la ultima fila y columna de la fecha. Coloco un ejemplo
    • @JSDJSD Excelentes, GRACIAS POR TU SOPORTE , me ayudo demasiado es exactamente lo que quería. 5 ESTRELLAS
    • 'Opción 1 Sub FiltrarSKUPorFecha(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim diccionarioSKU As Object Dim listaEliminar As Object Dim fechaActual As String, fechaSiguiente As String Dim f As Variant With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Crear diccionarios para comparar SKU y almacenar filas a eliminar Set diccionarioSKU = CreateObject("Scripting.Dictionary") Set listaEliminar = CreateObject("Scripting.Dictionary") ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then diccionarioSKU.RemoveAll ' Limpiar el diccionario antes de llenarlo ' Guardar los SKU de la fecha siguiente (solo de la siguiente) For f = fila + 1 To ultimaFila If .Cells(f, 1).Value <> fechaSiguiente Then Exit For diccionarioSKU(.Cells(f, 2).Value) = 1 Next f ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Solo eliminar si el SKU no está en la fecha siguiente If Not diccionarioSKU.exists(.Cells(f, 2).Value) Then listaEliminar(f) = 1 ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar.keys .Rows(f).Delete Next End With MsgBox "Completado correctamente.", vbInformation End Sub 'Opción 2 Sub FiltrarSKUPorFecha1(): Application.ScreenUpdating = False Dim ultimaFila As Long, fila As Long Dim listaEliminar As Collection Dim fechaActual As String, fechaSiguiente As String Dim f As Variant, i As Long Dim SKUExiste As Boolean With Sheets("Consolidado") ultimaFila = .Cells(.Rows.Count, 1).End(xlUp).Row ' Inicializar la colección para marcar las filas a eliminar Set listaEliminar = New Collection ' Recorrer desde la primera fila hasta la penúltima For fila = 2 To ultimaFila - 1 fechaActual = .Cells(fila, 1).Value fechaSiguiente = .Cells(fila + 1, 1).Value ' Solo comparar la fecha actual con la siguiente (inmediatamente superior) If fechaActual <> fechaSiguiente Then ' Revisar los SKU de la fecha actual y marcar los que deben eliminarse For f = fila To 2 Step -1 If .Cells(f, 1).Value <> fechaActual Then Exit For ' Comprobar si el SKU está en la fecha siguiente SKUExiste = False For i = fila + 1 To ultimaFila If .Cells(i, 1).Value <> fechaSiguiente Then Exit For If .Cells(i, 2).Value = .Cells(f, 2).Value Then SKUExiste = True Exit For End If Next i ' Si el SKU no se encuentra en la fecha siguiente, marcar para eliminar If Not SKUExiste Then listaEliminar.Add f ' Marcar fila para eliminar después End If Next f ' Ya no es necesario seguir buscando después de comparar la primera y la siguiente fecha Exit For End If Next fila ' Eliminar las filas marcadas sin afectar el bucle principal For Each f In listaEliminar .Rows(f).Delete Next f End With MsgBox "Completado correctamente.", vbInformation End Sub   TABLA ELIMINAR.xlsm
  • 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.