CALCUL DÉTAILLÉ DE FACTORIEL

Private Sub CommandButton1_Click()
'---------------------------------- Daniel Baudry -------------------
'    koomky@free.fr
'
'                          1 février 2008 - 52200 Langres
'
'--------------------------------------------------------------------
'Objet:
' ce code permet de calculer le factoriel de n'importe quel nombre
' pourvu que le dimensionnement du tableau appelé 'tablo()' soit fait
' en cohérence avec la dimension du résultat, en donnant tous les chiffres
'les uns derriere les autres, du résultat du factoriel
'
' Pour ce faire, si vous voyez que le résultat n'apparait pas ou que le
' code s'arrête, redimensionner tablo(), ainsi que xtablo et ytablo qui
' vont avec un peu plus loin en dessous.
'--------------------------------------------------------------------
'Principe:
' quand on multiplie un nombre par un autre (qu'il ait n chifrres ou 1 seul)
' on stocke chaque résultat dans un tableau, une ligne de tablo() récupérant
' les opérations d'un opérande.
' on stocke toutes les lignes des opérations, chacune d'elles relevant d'un
' opérande. exemple dans 18 x 17, une ligne de tablo stocke 1x7 et 8x7
' une autre ligne stocke 1x1 et 8x1.
' on fait la somme des lignes qu'on stocke dans une autre ligne de tablo(),
' puis on extrait les unités dans chaque cellule de tablo() et les dizaines
' sont additionnées à la cellule voisine de gauche.
' De proche en proche, la ligne de tablo() ne contient plus que des valeurs à
' 1 chiffre.
' par itérations successives, on remultiplie le résultat par la valeur suivante
' n-1, jusqu'à ce que n=1.
' on affiche ensuite le résultat final en entier et par tranches de 100 caractères
'allant de 0 à 9.
'
'--------------------------------------------------------------------------------
'mise en page
'--------------------------------------------------------------------------------
'nettoyage colonne C et plage calculs
ActiveSheet.Range("C2:c500").Select
Selection.ClearContents
ActiveSheet.Range("d2:d500").Select
Selection.ClearContents
ActiveSheet.Range("a1").Select
ActiveSheet.Range("d1") = "          450! donne exactement 1001 chiffres - Interrompre en cours de calcul avec CTRL +  Pause"
'-----------------------------------------------
'demande du nombre à factorialiser
v1 = InputBox("Entrer la valeur n! à factorialiser ... ", "Calcul de Factoriel n", 10)
'-------------- controle des caractères et signes
If Val(v1) = 0 Then v1 = "1": GoTo cestun:
If Val(v1) = 1 Then GoTo cestun:

If Val(v1) < 0 Then
    m = MsgBox("Pas de valeurs négatives SVP ! recommencez")
    Exit Sub
End If
If Abs(Int(Val(v1)) - Val(v1)) > 0 Then
    m = MsgBox("Que des nombres entiers SVP ! recommencez")
    Exit Sub
End If
lv1 = Len(v1)
For u = 1 To lv1
    If Asc(Right(Left(v1, u), 1)) < 48 Or Asc(Right(Left(v1, u), 1)) > 57 Then
        m = MsgBox("Que des valeurs faites de chiffres allant de 0 à 9 SVP ! recommencez")
    End If
Next
'-----------------------------------------------------------------------------------------------
On Error Resume Next
If v1 = "" Then Exit Sub 'si on annule l'inputBox
ActiveSheet.Range("c2") = v1
ActiveSheet.Range("d2") = "Nombre à factorialiser"
ActiveSheet.Range("d3") = " ...Opérande en cours de calcul"
'-----------------------------------------------
vp = v1 'à conserver
'-----------------------------------------------------------------------------
'              ATTENTION AU DIMENSIONNEMENT DU TABLEAU tablo()
'                    pour les grands factoriels >100
'-----------------------------------------------------------------------------
'si le resultat et impossible avec de grand nombre, allonger les dimensions du
'tableau tablo(), en y et x
'--------------------------------------------------------------------------------
'Dim tablo(50, 5000) 'tablo(ytablo,xtablo) c'est la MATRICE
xtablo = 10000
ytablo = 20
Dim tablo(10, 10000) As Integer
'ReDim tablo(ytablo, xtablo)
'ATTENTION, la première ligne de tablo() à l'indice 0, on s'en servira
'xtablo et ytablo définissent les dim du tableau, on ne peut les mettre dans tablo()
'comme ceci tablo(xtablo,ytablo), excel 2003 ne l'accepte pas
v2 = v1 - 1
'-------------------------------------------------------------------------------
zz = "|": zzz = ""
If Val(vp) > 200 Then
    po = Int(Val(vp) / 200) + 1
    For y = 1 To 200: zzz = zzz & zz: Next y: zzz = zzz & " - 100%"
Else
    po = 1
    For y = 1 To ActiveSheet.Range("c2"): zzz = zzz & zz: Next y: zzz = zzz & " - 100%"
End If
ActiveSheet.Range("d12") = zzz
nb = 0
dep = Now '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'on décompose v1 et v2 en chiffres pour réaliser le calcul
'--------------------------------------------------------------------------------
'd'abord, mise à zéro de la matrice tablo()
'--------------------------------------------------------------------------------
'décomposition de v1 en ses chiffres ----v1
For i = 1 To Len(Str(v1))
    'on stocke les chiffres 1 par 1
    tablo(2, i) = Left(Right(Str(v1), i), 1)
Next i
'la ligne 1 de tablo() contient les chiffres de v1
'---------------------- zone de bouclage de l'itération
bouclerfactoriel: 'ce repère est utilisé à partir de la 2 eme itération
nb = nb + 1
If nb = po Then
    ActiveSheet.Range("d11") = ActiveSheet.Range("d11") & "|"
    nb = 0
End If
'----------------------v2
For i = 1 To Len(Str(v2))
    tablo(1, i) = Left(Right(Str(v2), i), 1)
Next i
'la ligne 2 de tablo() contient les chiffres de v2
' ce qui donnerait dans tablo()
'colonnes                3        2       1
'                     -----------------------
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'-----------------------------------------------------------------------------------------------
'on multiplie tour à tour les chiffres de v2 avec tous ceux de v1, comme on le ferait
'manuellement dans une mutiplication de nombres
If (v2 = vp - 1) Then
    m1 = Len(Str(v1))  'cas premiere boucle
Else
    For e = xtablo To 1 Step -1
        If (tablo(2, e) > 0 And xtablo - e = 1) Then Stop:
        If tablo(2, e) > 0 Then m1 = e: Exit For 'boucles suivantes
        'donne le nombre de chiffres à traiter
    Next e
End If
m1 = m1 + 5
'on introduit dans tablo() le résultat de la multiplication.
'le (i-1) tient compte du décalage vers la gauche des dizaines
For i = 1 To Len(Str(v2)) 'ex 12
    For j = 1 To m1 '         ex 2, car longueur v1 = 2 (2 chiffres)
        tablo(2 + i, j + (i - 1)) = tablo(1, i) * tablo(2, j)
    Next j
    'For ii = j + 1 To xtablo: tablo(2 + i, ii) = 0: Next ii '-------$$$$$$$$$$$$$
Next i
'ce qui donne ceci dans tablo()
'colonnes          3        2       1
'                     -----------------------------
'                           1      2                        ligne 4 de tablo() (1x2 et 1x1)
'                                  3      6                 ligne 3 de tablo() (3x2 et 3x1)
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'-----------------------------------------------------------------------------------------------
'------------ on somme les lignes de tablo()
For z = 1 To xtablo + 2
    For y = 3 To ytablo '3 car c'est à partir de cette ligne que sont stockés les résultats
        tablo(0, z) = tablo(0, z) + tablo(y, z)
    Next y
Next z
'ce qui donne ceci dans tablo()
'colonnes                3        2       1
'                     -----------------------------
'                           1      2                        ligne 4 de tablo() (1x2 et 1x1)
'                                  3      6                 ligne 3 de tablo() (3x2 et 3x1)
'                                  1      2                 pour v2  ligne 2 de tablo()
'                                  1      3                 pour v1  ligne 1 de tablo()
'                           1      5      6                 ligne 0 de tablo(), somme des lignes 3 et 4
'-----------------------------------------------------------------------------------------------
'ici on ne laisse que des unités dans les cases de tablo() à sa ligne 0
'les dizianes sont reportées et ajoutées à la case juste à gauche
For z = 1 To xtablo + 1 'on scrute toute la ligne 0 de tablo()
    w = tablo(0, z)
    If w > 9 Then 'si la valeur dépase 9
       d = Val(Left(Str(w), Len(Str(w) - 1))) 'd=dizaine
       '--------------------- Bogue de VBA
        u = Val(Right(Str(w), 1)) 'u=unité, la méthode (A-int(A/10))*10 pour récupérer
        '                                    l'unité ne fonctionne pas correctement avec Excel
        If (d * 10 + u) <> w Then d = Int(w / 10)
        tablo(0, z) = u
        tablo(0, z + 1) = tablo(0, z + 1) + d
    Else
        tablo(0, z) = w
    End If
Next z
'For ii = z + 1 To xtablo: tablo(0, ii) = 0: Next ii '-------$$$$$$$$$$$$$
'--------------effacer partie de tablo()--------------------------
'on réitinialise tablo() à 0 sauf la ligne 0
For y = 1 To ytablo: For x = 0 To xtablo: tablo(y, x) = 0: Next x: Next y
'-------------- décrément de v2 pour boucler
v2 = v2 - 1
mot = "" 'mot servira à concaténer les valeurs trouvées lors du calcul
'on déplace la ligne 0 en ligne 1 et on vide cette ligne 0
For u = 1 To xtablo
    tablo(2, u) = tablo(0, u) 'devient v1
    '
    If tablo(0, u) = 0 Then t = "0" Else t = Str(tablo(0, u))
    mot = t & mot
    tablo(0, u) = 0
Next u
'For ii = u + 1 To xtablo: tablo(2, ii) = 0: Next ii '-------$$$$$$$$$$$$$
'on controle la taille du tableau tablo() ------------------------------------
GoTo ggoottoo:
For ta = xtablo To 1 Step -1
    If tablo(2, ta) > 0 Then
        xtablo = xtablo + 10
        ytablo = ytablo + 10
       ' ReDim Preserve tablo(xtablo, ytablo)
    End If
Next ta
ggoottoo:
'-----------------------------------------------------------------------------------
'ActiveSheet.Range("c" & 10) = mot
If v2 = 0 Then GoTo findecalcul:
    ActiveSheet.Range("c3") = v2 + 1
'-------------------------------------------------------------------------------
    GoTo bouclerfactoriel: 'on boucle jusqu'à ce que v2 =0
'----------------------------------------------------------------------------------
'                                            BOUCLAGE
'----------------------------------------------------------------------------------
findecalcul:
cestun:
If Val(v1) = 1 Then mot2 = "1": GoTo cestlafin:


fin = Now '$$$$$$$$$$$$$$$
ActiveSheet.Range("d11") = ActiveSheet.Range("d11") & "| - 100%" 'image de barre de progression (facultatif) = 100%
'
For y = 1 To Len(mot)
    If (Left(mot, 1)) = "0" Then mot = Right(mot, Len(mot) - 1) Else Exit For
Next y
'
mot2 = ""
For y = 1 To Len(mot)
    If Mid(mot, y, 1) = " " Then GoTo encore:
        mot2 = mot2 & Mid(mot, y, 1)
encore:
Next y
'----------------------------------------------------------------------------------------------------
cestlafin: '***
'----------------------------------------------------------------------------------------------------
ActiveSheet.Range("c" & 10) = "_" & mot2
ActiveSheet.Range("d3") = "Nombre de caractères du résultat hors tirait bas"
ActiveSheet.Range("d12") = "Par tranches de 100 chiffres, du haut (les + grandes) vers le bas (les unités)"
'ActiveSheet.Range("c13") = "Tranche la plus à droite (unités)"
k = "Factoriel " & v1 & " = " & v1 & "! = "
k = k & v1 & " x " & v1 - 1 & " x " & v1 - 2 & " x " & v1 - 3 & "( ... x 3 x 2 x 1) ="
ActiveSheet.Range("c9") = k
ActiveSheet.Range("D5") = "Pour de petits factoriels (<200) réduire la dimension de tablo()"
ActiveSheet.Range("D6") = "au début du code. Le gain de temps sera amplifié."
lonmot = Len(mot2) - 1
'----------------mise en forme par tranches
ActiveSheet.Range("c3") = lonmot
'nombre de tranches de 100 caractères
mot3 = mot2
delai = fin - dep 'format
delai = Format(delai, "##,##0.0000000000")
delai = delai * 24 * 3600
delai = Int(delai * 1000) / 1000
ActiveSheet.Range("d12") = ActiveSheet.Range("d12") & " - Total chiffres = " & Len(mot3) & " - délai = " & delai & " sec."
nt = lonmot / 100
nte = Int(nt)
For i = 1 To nte
    ActiveSheet.Range("D" & 12 + i) = "_" & Left(mot3, 100)
    mot3 = Right(mot3, Len(mot3) - 100)
Next i
ActiveSheet.Range("D" & 12 + i) = "_" & mot3
End Sub

Private Sub CommandButton2_Click()
Sheets("Conseil").Select
End Sub

Télécharger le zip

22 mars 2008 20:47:26 :

le zip précédent comprend une erreur native venant d'Excel que j'ai modifié dans ce dernier. Mieux vaut supprimer le premier zip. merci