Soyez le premier à donner votre avis sur cette source.
Vue 12 515 fois - Téléchargée 368 fois
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
j'ai lu les autres applis sur les factoriels, avec les remarques concernant la vitesse.
Je travaille sur un algorithme, mais dans le cas présent, je voulais répondre à un objectif, comme la justesse du résultat.
Patrice 99, j'ai tenu compte de ta remarque, ma réponse est la même que celle faite à US_30.
Je réfléchis à un traitement matriciel, et à la non prise en compte des 0 qui s'alignent par centaines et font perdre du temps.
Mais ce sera peut etre autre chose.
Bien à vous.
Le résultat du calcul est juste, c'est un bon point. Mais... lorsqu'on fait un calcul avec les grands nombres, on cherche surtout un algorithme rapide... et c'est pas le cas ici. Sache qu'on peut arriver en une seule seconde au calcul de la factorielle 5000. Mais rien ne dit que se record ne pas être battu... Un 10/10 d'encouragement.
Amicalement,
Us.
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.