1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
|
Function Factorielle(ByVal N As Long) As String
'définitions des variables
Dim R(100000) As Double, S As Double
Dim K As Long, M As Long, MAX As Long
Dim E4 As Long, E5 As Long
Dim L As Long, L1 As Long
Dim RET As Long, B As Long, C2 As Long
Dim C1 As Double, B2 As Double, C As Double
Dim t As Long
Dim ef As String
'initialisation des variables
R(1) = 0.00001
M = 2
MAX = 1
E5 = 100000
E4 = 10000
Do While M <= N
DebutWhile:
S = R(K)
B = Int(S)
C = (RET + Int(E5 * (S - B) + 0.5) * M) / E5
C2 = Int(C)
C1 = Int(E5 * (C - C2) + 0.5) / E5
B2 = B * M + C2
If B2 >= E4 Then
'deuxième série
B2 = B2 / E4
RET = Int(B2)
R(K) = Int(0.5 + (B2 - RET) * E4) + C1
K = K + 1
If K <= MAX Then GoTo DebutWhile
R(K) = RET / E5
MAX = MAX + 1
If MAX > 10000 Then End
GoTo Increm
End If
R(K) = B2 + C1
RET = 0
If K <> MAX Then K = K + 1 : GoTo DebutWhile
Increm:
'incrémentation de M; fin de la 'multiplication'
M = M + 1
K = 1
RET = 0
Loop
For t = MAX To 1 Step -1
S = Int(0.5 + R(t) * E5)
If S = 0 Then
L = 8
Else
L = 8 - Int(Math.Log(S + 0.5) / Math.Log(10))
If L = 0 Or t = MAX Then GoTo CreateString
End If
ef = ef & "".PadLeft(L, "0")
CreateString:
ef = ef & S.ToString
Next t
Return ef
End Function |
Partager