** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - Primos entre dos números
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoPrimos entre dos números

 Responder Responder
Autor
Mensaje
Sheerkhan Ver desplegable
Asiduo
Asiduo


Unido: 01/Octubre/2011
Estado: Sin conexión
Puntos: 251
Enlace directo a este mensaje Tema: Primos entre dos números
    Enviado: 05/Abril/2018 a las 19:38
Devuelve una matriz con los primos comprendidos entre dos números, y como "añadido", muestra en un mensaje con el tiempo empleado y la cantidad de números primos encontrados.

Saludos, Sheerkhan
'--------------------------

Public Function N_Primos(NumIni As Double, NumFin As Double) As Variant
'Devuelve una matriz con los primos comprendidos entre dos números
'uso: N_Primos (1, 100)
'autor: EBS "Sheerkhan"

   On Error GoTo N_Primos_Error
'*****************
Dim N As Double       'Número a evaluar
Dim i As Double       'Variable incremental
Dim k As Double       'Raíz cuadrada del número a evaluar
Dim y As Long        'Índice de la matriz
Dim EsPrimo As Boolean
Dim MisPrimos() As Variant

Dim IniTimer As Single
IniTimer = Timer

If NumIni < 1 Or IsNull(NumIni) _
Or NumFin < 1 Or IsNull(NumFin) Then
    MsgBox "Deben ser positivos y mayores de cero."
    Exit Function
End If

'me aseguro de que sean enteros
NumIni = Int(NumIni)
NumFin = Int(NumIni)

'Compruebo el orden de los valores
If NumFin < NumIni Then
    N = NumFin
    NumFin = NumIni
    NumIni = N
End If

For N = NumIni To NumFin Step 1

    EsPrimo = False

    If N = 2 Or N = 3 Then
        EsPrimo = True
    'descarto todos los pares
    ElseIf N Mod 2 = 0 Then
        EsPrimo = False
    Else
        k = Sqr(N) 'Raiz cuadrada del número a evaluar
        For i = 3 To N Step 2
        Debug.Print "i " & i; " Mod "; N Mod i
            If N Mod i = 0 Then
               EsPrimo = False
               Exit For
            ElseIf i > k Then
               EsPrimo = True
               Exit For
            End If
        Next i
    End If

    If EsPrimo = True Then
        ReDim Preserve MisPrimos(y)
        MisPrimos(y) = N
        y = y + 1
    End If
Next N

MsgBox "Tiempo empleado: " & Timer - IniTimer & vbCrLf & y & " Números primos."

N_Primos = MisPrimos

'******************
   On Error GoTo 0
   Exit Function
N_Primos_Error:
    'Cuando la matriz está vacía, se produce este error
    If Err.Number = 9 Then
        MsgBox "No hay números primos."
        Exit Function
    End If
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function N_Primos del Módulo Mdl_Primos"
End Function
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable