Generar tres números al azar para una rifa

Martha su pregunta es compleja y requiere de varias funciones. Estas funciones hacen uso de colecciones y diccionarios. Personalmente hace muchos años elabore en Access VBA un sistema de rifas en Colombia con muchas más posibilidades. Le he preparado este ejemplo donde considero 3 o 4 opciones, con unos ajustes lo puede adaptar para 1,2,5 opciones y más. Este es el código.

Public Function LlenarTabla(idVendedorFiltro As Long, totalFilas As Integer)
    'Parámetros:
    '            idVendedorFiltro= El idvendedor de la tabla tblvendedores
    '            totalfilas= Número de bonos o boletas a crear
    'Autor:      Eduardo Pérez Fernández
    'Versión     1.1 (Con barra de progreso)
    'Fecha       04/12/2024
    'Si utiliza este código en sus proyecto respete la autoría
    Dim db As DAO.Database
    Dim rsVendedor As DAO.Recordset
    Dim rsOpciones As DAO.Recordset
    Dim idVendedor As Long
    Dim cantidadNumeros As Integer
    Dim juegacuatro As Boolean
    Dim numerosGenerados As Collection
    Dim numerosConcatenados As String
    Dim i As Integer
    Dim saldo_nros As Integer
    Dim nros_enfilas As Integer
    Dim frmProgress As Form
    On Error GoTo ManejarErrores
    Set db = CurrentDb
    Randomize ' Inicializa el generador de números aleatorios
    ' Filtrar la consulta para obtener solo el vendedor especificado
    Set rsVendedor = db.OpenRecordset("SELECT idvendedor, juegacuatro FROM tblvendedores WHERE idvendedor = " & idVendedorFiltro)
    Set rsOpciones = db.OpenRecordset("SELECT idvendedor, numeros FROM tbl4opciones", dbOpenDynaset)
    ' Verifica si se encontró el vendedor especificado
    If rsVendedor.EOF Then
        MsgBox "No se encontró un vendedor con el ID proporcionado.", vbExclamation, "Error..."
        Exit Function
    End If
    ' Procesar el vendedor filtrado
    idVendedor = rsVendedor!idVendedor
    juegacuatro = rsVendedor!juegacuatro  'Obtiene si juega 4 o 3 opciones
    ' Determina la cantidad de números según juegacuatro
    If juegacuatro Then
        cantidadNumeros = 4
    Else
        cantidadNumeros = 3
    End If
    ' Verifico los números disponibles
    nros_enfilas = cantidadNumeros * totalFilas
    saldo_nros = SaldoNumeros()
    If saldo_nros < nros_enfilas Then
        MsgBox "No quedan sino " & Int(saldo_nros / cantidadNumeros) & " fracciones disponibles" & vbCrLf & _
        "de " & cantidadNumeros & " números", vbInformation, "Le informo"
        Exit Function
    End If
    ' Abre el formulario de la barra de progreso
    DoCmd.OpenForm "frmProgressBar", acNormal
    Set frmProgress = Forms("frmProgressBar")
    ' Inicializa la barra de progreso
    frmProgress.txtProgress.Width = 0
    frmProgress.lblStatus.Caption = "0%"
    ' Genera números aleatorios para las filas
    For i = 1 To totalFilas
        ' Genera y concatena números únicos para la fila
        Set numerosGenerados = New Collection
        Call GenerarNumerosUnicos(numerosGenerados, cantidadNumeros)
        numerosConcatenados = ConcatenarNumeros(numerosGenerados)
        ' Inserta la fila en tbl4opciones
        rsOpciones.AddNew
        rsOpciones!idVendedor = idVendedor
        rsOpciones!numeros = numerosConcatenados
        rsOpciones.Update
        ' Actualiza la barra de progreso
        Call ActualizarBarraProgreso(frmProgress, i, totalFilas)
        ' Permite que Access procese eventos pendientes
        DoEvents
    Next i
    ' Limpieza
    RsOpciones. Close
    RsVendedor. Close
    Set rsOpciones = Nothing
    Set rsVendedor = Nothing
    Set db = Nothing
    ' Cierra el formulario de la barra de progreso
    DoCmd.Close acForm, "frmProgressBar"
    Exit Function
ManejarErrores:
    MsgBox "Se produjo un error: " & Err.Description, vbCritical, "Error"
    If Not frmProgress Is Nothing Then
        DoCmd.Close acForm, "frmProgressBar"
    End If
End Function
Private Sub ActualizarBarraProgreso(frm As Form, progresoActual As Integer, progresoTotal As Integer)
    Dim porcentaje As Integer
    Dim anchoMaximo As Integer
    Dim anchoProgreso As Integer
    anchoMaximo = 300 ' Ancho máximo de la barra de progreso en píxeles (ajusta este valor si lo deseas)
    ' Calcula el porcentaje de progreso
    porcentaje = (progresoActual / progresoTotal) * 100
    ' Calcula el ancho proporcional de la barra en función del porcentaje
    anchoProgreso = (anchoMaximo * porcentaje) / 100
    ' Asegúrate de que el ancho calculado no exceda el ancho máximo permitido
    If anchoProgreso > anchoMaximo Then
        anchoProgreso = anchoMaximo
    End If
    ' Actualiza la barra de progreso visual
    frm.txtProgress.Width = anchoProgreso
    frm.lblStatus.Caption = porcentaje & "%"
End Sub
' Función auxiliar para generar números únicos
Private Sub GenerarNumerosUnicos(ByRef numerosGenerados As Collection, ByVal cantidadNumeros As Integer)
    Dim nuevoNumero As String
    Do While numerosGenerados.Count < cantidadNumeros
        nuevoNumero = Format(Int((9999 - 0 + 1) * Rnd + 0), "0000")
        If Not ExisteNumero(numerosGenerados, nuevoNumero) And Not NumeroExisteEnTabla(nuevoNumero) Then
            numerosGenerados.Add nuevoNumero, nuevoNumero
        End If
    Loop
End Sub
' Función auxiliar para concatenar números generados
Private Function ConcatenarNumeros(ByVal numeros As Collection) As String
    Dim numero As Variant
    Dim resultado As String
    resultado = ""
    For Each numero In numeros
        If resultado = "" Then
            resultado = numero
        Else
            resultado = resultado & "-" & numero
        End If
    Next numero
    ConcatenarNumeros = resultado
End Function
' Función para verificar si un número ya existe en la tabla tbl4opciones
Private Function NumeroExisteEnTabla(nuevoNumero As String) As Boolean
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim existe As Boolean
    Dim i As Integer
    Set db = CurrentDb
    ' Consulta la tabla para ver si el número ya existe en otra fila
    Set rs = db.OpenRecordset("SELECT numeros FROM tbl4opciones")
    ' Busca el número exacto en la tabla
    Do While Not rs.EOF
        Dim numerosArray() As String
        numerosArray = Split(rs!numeros, "-")
        For i = LBound(numerosArray) To UBound(numerosArray)
            If numerosArray(i) = nuevoNumero Then
                existe = True
                Exit Do
            End If
        Next i
        rs.MoveNext
    Loop
    ' Cerrar recordset
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    NumeroExisteEnTabla = existe
End Function
' Función auxiliar para verificar si un número ya existe en una colección
Function ExisteNumero(ByVal col As Collection, ByVal numero As String) As Boolean
    Dim item As Variant
    ExisteNumero = False
    ' Recorre la colección para ver si el número ya existe
    For Each item In col
        If item = numero Then
            ExisteNumero = True
            Exit Function
        End If
    Next item
End Function
' Función para validar el saldo de números disponibles
 Function SaldoNumeros() As Integer
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim numerosUsados As Collection
    Dim numeroActual As String
    Dim totalNumerosEnUso As Integer
    Dim numerosDisponibles As Integer
    Dim i As Integer
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT numeros FROM tbl4opciones")
    Set numerosUsados = New Collection
    ' Recorrer la tabla y almacenar los números únicos en la colección
    Do While Not rs.EOF
        Dim numerosArray() As String
        numerosArray = Split(rs!numeros, "-")
        For i = LBound(numerosArray) To UBound(numerosArray)
            numeroActual = numerosArray(i)
            ' Solo agregar si el número no está ya en la colección
            On Error Resume Next
            numerosUsados.Add numeroActual, numeroActual
            On Error GoTo 0
        Next i
        rs.MoveNext
    Loop
    ' Calcular el total de números únicos en uso
    totalNumerosEnUso = numerosUsados.Count
    ' Calcular cuántos números quedan disponibles
    numerosDisponibles = 10000 - totalNumerosEnUso
    SaldoNumeros = numerosDisponibles
    ' Limpieza
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Function
Public Function ExisteEnTabla(nuevoNumero As String) As Long
    ' Función para verificar si un número ya existe en la tabla tbl4opciones
    ' Retorna el idvendedor, si no existe retorna 0
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Integer
    Dim id As Long
    id = 0 ' Asegurar que está inicializado a 0
    Set db = CurrentDb
    ' Consulta la tabla para ver si el número ya existe en otra fila
    Set rs = db.OpenRecordset("SELECT idvendedor, numeros FROM tbl4opciones")
    ' Busca el número exacto en la tabla
    Do While Not rs.EOF
        Dim numerosArray() As String
        numerosArray = Split(rs!numeros, "-")
        For i = LBound(numerosArray) To UBound(numerosArray)
            If Trim(numerosArray(i)) = Trim(nuevoNumero) Then ' Se asegura de comparar sin espacios en blanco
                id = rs!idVendedor
                Exit Do
            End If
        Next i
        rs.MoveNext
    Loop
    ' Cerrar recordset
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    ExisteEnTabla = id
End Function
Public Function ObtenerNumerosNoEnTabla() As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dictNumerosExistentes As Object
    Dim numeros As String
    Dim numero As Variant
    Dim resultado As String
    Dim numeroActual As String
    Dim numerosSeparados As Variant
    Dim i As Long
    ' Crear un diccionario para almacenar los números existentes en la tabla
    Set dictNumerosExistentes = CreateObject("Scripting.Dictionary")
    ' Abrir la tabla de opciones para obtener los números existentes
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT numeros FROM tbl4opciones", dbOpenSnapshot)
    ' Llenar el diccionario con los números existentes (como cadenas de texto)
    Do While Not rs.EOF
        ' Obtener los números de la columna "numeros" y separarlos por guiones
        numeros = rs!numeros
        numerosSeparados = Split(numeros, "-") ' Separar la cadena por el guion
        ' Llenar el diccionario con cada número individual
        For i = LBound(numerosSeparados) To UBound(numerosSeparados)
            dictNumerosExistentes(CStr(numerosSeparados(i))) = True
        Next i
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    ' Ahora iteramos sobre todos los números de 4 dígitos posibles ("0000"-"9999")
    resultado = ""
    For numero = 0 To 9999
        numeroActual = Format(numero, "0000") ' Asegura que el número sea de 4 dígitos (con ceros a la izquierda)
        ' Verifica si el número no está en el diccionario
        If Not dictNumerosExistentes.Exists(numeroActual) Then
            ' Si no está en el diccionario, lo agregamos al resultado
            resultado = resultado & numeroActual & ", "
        End If
    Next numero
    ' Si se encontraron números faltantes, devolverlos, eliminando la última coma
    If Len(resultado) > 0 Then
        resultado = Left(resultado, Len(resultado) - 2) ' Elimina la última coma y espacio
    End If
    ' Devolvemos los números faltantes
    ObtenerNumerosNoEnTabla = resultado
End Function
Public Function InsertarNumerosNoEnTabla()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim dictNumerosExistentes As Object
    Dim numeros As String
    Dim numero As Variant
    Dim numeroActual As String
    Dim numerosSeparados As Variant
    Dim i As Long
    Dim rsInsertar As DAO.Recordset
    'Elimino los datos de la tabla temporal
    CurrentDb.Execute "DELETE FROM tem_libres_cuatro_opciones"
    ' Crear un diccionario para almacenar los números existentes en la tabla
    Set dictNumerosExistentes = CreateObject("Scripting.Dictionary")
    ' Abrir la tabla de opciones para obtener los números existentes
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT numeros FROM tbl4opciones", dbOpenSnapshot)
    ' Llenar el diccionario con los números existentes (como cadenas de texto)
    Do While Not rs.EOF
        ' Obtener los números de la columna "numeros" y separarlos por guiones
        numeros = rs!numeros
        numerosSeparados = Split(numeros, "-") ' Separar la cadena por el guion
        ' Llenar el diccionario con cada número individual
        For i = LBound(numerosSeparados) To UBound(numerosSeparados)
            dictNumerosExistentes(CStr(numerosSeparados(i))) = True
        Next i
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    ' Abrir la tabla "tem_libres_cuatro_opciones" para insertar los números faltantes
    Set rsInsertar = db.OpenRecordset("tem_libres_cuatro_opciones", dbOpenDynaset)
    ' Iteramos sobre todos los números de 4 dígitos posibles ("0000"-"9999")
    For numero = 0 To 9999
        numeroActual = Format(numero, "0000") ' Asegura que el número sea de 4 dígitos (con ceros a la izquierda)
        ' Verifica si el número no está en el diccionario
        If Not dictNumerosExistentes.Exists(numeroActual) Then
            ' Si no está en el diccionario, lo insertamos en la tabla "tem_libres_cuatro_opciones"
            rsInsertar.AddNew
            rsInsertar!numero = numeroActual
            rsInsertar.Update
        End If
    Next numero
    ' Limpieza
    rsInsertar.Close
    Set rsInsertar = Nothing
    Set db = Nothing
End Function

Este código de VBA tiene varias funciones relacionadas con la generación y manejo de números aleatorios asociados a vendedores, así como la gestión de una barra de progreso para mostrar visualmente el avance de la generación. A continuación, le dejo un desglose de las secciones principales:

1. Función LlenarTabla

Esta es la función principal que genera números aleatorios para los vendedores. Parámetros:

• IdVendedorFiltro: El ID del vendedor para el cual se generarán los números.
• TotalFilas: Cantidad de filas o registros a generar.

Pasos principales:

1. Inicialización:

   • Conecta a la base de datos (db) y abre los Recordset de las tablas tblvendedores y tbl4opciones.
   • Verifica si el vendedor con el idVendedorFiltro existe y obtiene si utiliza 3 o 4 números por fila (juegacuatro).

2. Validación:

   • Calcula cuántos números son necesarios (nros_enfilas) y verifica si hay suficientes números disponibles en la tabla (SaldoNumeros()).

3. Generación de números:

   • Por cada fila, genera una colección de números aleatorios únicos (GenerarNumerosUnicos) y los concatena en una cadena (ConcatenarNumeros).
   • Inserta la fila con el vendedor y los números generados en tbl4opciones.

4. Barra de progreso:

   • Abre un formulario con una barra de progreso (frmProgressBar) para mostrar el porcentaje completado.
   • La barra se actualiza en cada iteración usando la función ActualizarBarraProgreso.

5. Limpieza:

   • Cierra los objetos abiertos (recordsets y conexión a la base de datos).
   • Maneja errores y asegura que el formulario de progreso se cierra si ocurre un error.

2. Función ActualizarBarraProgreso

Esta función actualiza la barra de progreso visual del formulario:

• Calcula el porcentaje completado.
• Ajusta el ancho de la barra en píxeles proporcional al porcentaje.
• Actualiza el texto que muestra el porcentaje completado.

3. Función GenerarNumerosUnicos

Genera una colección de números aleatorios de 4 dígitos que:

• No estén repetidos dentro de la colección generada.
• No existan ya en la tabla tbl4opciones (verifica con NumeroExisteEnTabla).

Cómo funciona:

• Usa Rnd para generar un número aleatorio entre 0000 y 9999.
• Verifica si el número ya está en uso antes de agregarlo a la colección.

4. Función ConcatenarNumeros

Concatena los números generados en una cadena separada por guiones (-).

Ejemplo: Si los números son 1234, 5678, y 9101, la función retorna 1234-5678-9101.

5. Función SaldoNumeros

Calcula cuántos números de 4 dígitos están aún disponibles:

• Crea una colección de todos los números únicos usados en tbl4opciones.
• Resta el total de números en uso de los 10,000 posibles (0000-9999).

6. Función NumeroExisteEnTabla

Verifica si un número ya está registrado en la tabla tbl4opciones:

• Abre un Recordset de tbl4opciones.
• Divide cada registro en una lista de números (separados por -) y busca el número proporcionado.

7. Función ObtenerNumerosNoEnTabla

Devuelve una lista de todos los números de 4 dígitos que no están en uso:

• Usa un diccionario (Scripting. Dictionary) para almacenar los números usados.
• Itera sobre todos los números posibles (0000 a 9999) y selecciona los que no estén en el diccionario.

Propósito General

El código:

• Automatiza la generación y asignación de números a vendedores.
• Garantiza que los números sean únicos y que no se repitan.
• Utiliza una barra de progreso para mejorar la experiencia del usuario.
• Incluye validaciones para evitar errores y asegurar que las operaciones sean consistentes.

Cómo tengo su correo le envío el ejemplo, este código es la clave para numerar boletos de rifas, quien quiera el ejemplo lo puede solicitar a [email protected]

Le dejo la respuesta a su segunda pregunta.

SELECT tbl3opciones.idfraccion, tbl3opciones.idvendedor, Mid([numeros],1,4) AS Nro1, Mid([numeros],6,4) AS Nro2,
 IIf(Len([numeros])>9,Mid([numeros],11,4),Null) AS Nro3, IIf(Len([numeros])>14,Mid([numeros],16,4),Null) AS Nro4
FROM tbl3opciones;

Esta consulta muestra las columnas:

Idfraccion idvendedor Nro1 Nro2 Nro3 Nro4

Les dejo el link de este software que elaboré en Python. Hacer boletas para rifas en PDF - RifaPDF 2.1

Martha observe porque utilizo PostgreSQL por eficiencia. Para los amantes de PostgreSQL les dejo el script de la función.

CREATE OR REPLACE FUNCTION llenar_tabla(
    id_vendedor_filtro BIGINT,
    total_filas INTEGER
) RETURNS BOOLEAN AS $$
DECLARE
    cantidad_numeros INTEGER;
    saldo_numeros INTEGER;
    nros_en_filas INTEGER;
    numeros_generados TEXT[] := '{}';
    numeros_concatenados TEXT;
    i INTEGER;
    numero_generado TEXT;
    juega_cuatro_flag BOOLEAN;
    ancho_maximo INTEGER := 10000; -- Total de combinaciones posibles
BEGIN
    -- Verifica si el vendedor existe y obtiene juegacuatro
    SELECT juegacuatro INTO juega_cuatro_flag
    FROM tblvendedores
    WHERE idvendedor = id_vendedor_filtro;
    IF NOT FOUND THEN
        RETURN FALSE; -- Retorna FALSE si el vendedor no existe
    END IF;
    -- Determina la cantidad de números a generar por fila
    cantidad_numeros := CASE WHEN juega_cuatro_flag THEN 4 ELSE 3 END;
    -- Calcula cuántos números quedan disponibles
    SELECT ancho_maximo - COUNT(*)
    INTO saldo_numeros
    FROM tbl3opciones, unnest(string_to_array(numeros, '-')) AS numero;
    nros_en_filas := cantidad_numeros * total_filas;
    IF saldo_numeros < nros_en_filas THEN
        RETURN FALSE; -- Retorna FALSE si no hay suficientes números disponibles
    END IF;
    -- Genera filas con números únicos
    FOR i IN 1..total_filas LOOP
        -- Genera números únicos para la fila
        numeros_generados := '{}';
        WHILE array_length(numeros_generados, 1) IS NULL OR array_length(numeros_generados, 1) < cantidad_numeros LOOP
            numero_generado := to_char(FLOOR(random() * ancho_maximo)::INTEGER, 'FM0000');
            IF NOT EXISTS (
                SELECT 1
                FROM tbl3opciones, unnest(string_to_array(numeros, '-')) AS numero
                WHERE numero = numero_generado
            ) AND NOT (numero_generado = ANY(numeros_generados)) THEN
                numeros_generados := array_append(numeros_generados, numero_generado);
            END IF;
        END LOOP;
        -- Concatena los números generados
        numeros_concatenados := array_to_string(numeros_generados, '-');
        -- Inserta la nueva fila en tbl3opciones
        INSERT INTO tbl3opciones (idvendedor, numeros)
        VALUES (id_vendedor_filtro, numeros_concatenados);
    END LOOP;
    -- Si todo se ejecuta correctamente, retorna TRUE
    RETURN TRUE;
EXCEPTION
    WHEN OTHERS THEN
        -- Captura errores y retorna FALSE
        RETURN FALSE;
END;
$$ LANGUAGE plpgsql;

¿Sabe cuánto tarda el PostgreSQL en procesar 500 líneas?... 6 segundos. Espero con esto dar por concluida la respuesta a su pregunta.