Function Np(ByVal A As Double, Optional ByVal Opt As Variant = "?")
'Si Opt="?" : Renvoi VRAI ou FAUX selon que le nombre est premier ou pas
'Si Opt="pn" : renvoi la valeur du Nième nb premier
'Si Opt="pi" : renvoi le nombre de nombre premier inférieurs ou égal à A : pi(x)
'Si Opt="fact" : renvoi la décomposition en facteurs premiers

'Traitement du type
Opt = LCase(CStr(Opt))
If Opt = "?" Then Np = CBool(False)
If Opt = "np" Or Opt = "pi" Then Np = CDbl(Np)
If Opt = "fact" Then Np = CStr(Np)

'Traitement A en entier positif
A = Abs(Int(A))

'Définitions des variables optimisés par le type de déclaration (Long ou Double)
Dim B As Double, nb() As Byte
Dim liste As Long, Saut As Long, t As Long, A1 As Long, A2 As Long
If A > 2147483647 Then 'valeur limite du type long
    liste = CDbl(liste): Saut = CDbl(Saut): t = CDbl(t): A1 = CDbl(A1): A2 = CDbl(A2)
End If

'Traitement option
Select Case Opt

Case "?" 'VRAI ou FAUX ?
    
    'Reponse
    Select Case A
    Case Is <= 1
        Np = False
    Case Else
        Np = (NbDiv(A) = 1)
    End Select


Case "pi" 'Fonction pi(x)
    
    'Cas particuliers
    If A < 2 Then Np = 0: Exit Function
    If A = 2 Then Np = 1: Exit Function
    
    'Valeurs des bornes
    A1 = Int((A ^ 0.5 - 3) / 2)
    A2 = Int((A - 3) / 2)
    
    'Cherche nb premier
    GoSub Eratosthene
    
    'Compte le nb de nb premiers
    For t = 0 To A2
        If nb(t) = 0 Then
            B = B + 1
        End If
    Next t
    Np = B + 1


Case "pn" 'Valeur du Nième nombre premier
    
    If A = 1 Then Np = 2: Exit Function
    
    'Borne supérieure de recherche : formule empirique testée jusqu'à A=2 millions
    'Le mini est atteint pour A=26218
    Dim bs As Double
    bs = A * (Log(A) + Log(Log(A))) + 232 - A / 1.05

    'Valeurs des bornes
    A1 = Int((bs ^ 0.5 - 3) / 2)
    A2 = Int((bs - 3) / 2)
    
    'Cherche nb premier
    GoSub Eratosthene

    'Compte
    B = 1
    For t = 0 To A2
        If nb(t) = 0 Then
            B = B + 1
            If B = A Then Np = 2 * t + 3: Exit Function
        End If
    Next t
    Np = B
    

Case "fact" 'Décomposition en facteurs premiers
    If A = 0 Then Np = "0": Exit Function
    Dim memnb As Double
    
    'Boucle de recherche
    Do
        B = NbDiv(A)
        If B = 1 Then Exit Do
        t = 0
        Do
            memnb = B: A = A / B: t = t + 1: B = NbDiv(A)
        Loop While B = memnb
        t = IIf(memnb = A, t + 1, t)
        Np = Np & Trim(Str(memnb)) & IIf(t > 1, "^" & Trim(t), "") & "*"
    Loop Until B = 1
    
    If A <> memnb Then
        Np = Np & Trim(Str(A)) 'rajoute la dernière valeur
    Else
        Np = Left(Np, Len(Np) - 1) 'enlève la dernière étoile
    End If

End Select

Exit Function

Eratosthene:
'Tableau de nb
ReDim nb(A2)
'Crible : Génère la liste des nombres premiers impair
For liste = 0 To A1
    If nb(liste) = 0 Then
    Saut = 2 * liste + 3
    For t = (Saut ^ 2 - 3) / 2 To A2 Step Saut
        nb(t) = 1
    Next t
    End If
Next liste
Return

End Function