Factorielle

Télécharger le projet
Commenter

Description

Ce code sert à calculer rapidement une factorielle complète, cad sans virgule et sans notation scientifique. Pour exemple, 1000! comprend 2568 chiffres.

Source / Exemple : 


Sub form_load()
    resultat.Text = ""
    longueur.Caption = ""
    progression.Visible = False
    progression.Value = 0
End Sub
Sub calfact()
    Dim reg() As Double
    Dim n As Double
    Dim nb_reg As Double
    Dim i As Double
    Dim j As Double
    progression.Visible = True
    progression.Value = 0
    longueur.Caption = ""
    resultat.Text = ""
    titre = "Saisie."
retour_fact:
    'Saisie du nombre
    valeur = InputBox("Valeur de n =", titre, 70)
    If valeur = "" Then Exit Sub
    n = Val(valeur)
    'Test si n entier
    If n <> Int(n) Then
        titre = "n doit être entier !!!"
        Beep
        GoTo retour_fact
    End If
    'Calcul et affichage de la longueur de la factorielle (propriété des log => log(a*b)=log(a)+log(b))
    nb_reg = 0
    For i = 1 To n
        nb_reg = nb_reg + log10(i)
    Next i
    longueur.Caption = n & " ! comprend " & Int(nb_reg + 1) & " chiffres."
    DoEvents
    'initialisations des registres
    taille_reg = 10
    nb_reg = Int(Int(nb_reg + 1) / taille_reg) + 1
    ReDim reg(nb_reg + 1)
    'Mise à 1 du 1er registre sinon n!=0
    reg(1) = 1
    'nb de registre concerné par le calcul=1
    nr = 1
    'Début de calcul
    For i = 1 To n
        DoEvents
        progression.Value = Int(100 * i / n)
        retenue = 0
        j = 1
        While j <= nr
            reg(j) = reg(j) * i + retenue
            retenue = Int(reg(j) / 10 ^ (taille_reg))
            reg(j) = reg(j) - retenue * 10 ^ (taille_reg)
            'test de la retenue, si <>0 alors ajout d'un registre pour propagation de la retenue
            If retenue <> 0 And j = nr Then nr = nr + 1
            j = j + 1
        Wend
    Next i
    affichage = ""
    For k = 1 To nb_reg
        t = Trim(Str(reg(nb_reg + 1 - k)))
        If (nb_reg + 1 - k) = nb_reg Then GoTo aff
        If t = "" Or t = "0" Then t = "0000000000"
        If Len(t) < 10 Then
            For m = 1 To 10 - Len(t)
                t = "0" + t
            Next m
        End If
aff:
        affichage = affichage + t
    Next k
    resultat.Text = affichage
    progression.Value = 0
    progression.Visible = False
End Sub
Function log10(x As Double) As Double
    log10 = Log(x) / Log(10)
End Function
Private Sub Command1_Click()
    calfact
End Sub

Conclusion :


Je pense que ce code peut être largement optimisé mais je débute alors excusez les erreurs de débutants.
Merci pour vos remarques éventuelles !
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.