Function AGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'ADDITION SIGNEE DE 2 GRANDS NOMBRES

'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)

'Recherche des signes et conversion en nombre positif
Dim S1 As Long, S2 As Long
S1 = 1: S2 = 1
If Left$(Nb1, 1) = "-" Then S1 = -1: Nb1 = Right$(Nb1, L1 - 1): L1 = L1 - 1
If Left$(Nb2, 1) = "-" Then S2 = -1: Nb2 = Right$(Nb2, L2 - 1): L2 = L2 - 1
     
'Recherche de la décimale et conversion en entier
Dim P1 As Long, P2 As Long, Virgule As Long, PS1 As Long, PS2 As Long
Dim Z As String 'optimisation pour les string$ qui suivent
Z = "0"
  
    'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    Dim Nb1Prov As String, Nb2Prov As String
    PS1 = 0: PS2 = 0
    If P1 > 0 Then
        PS1 = L1 - P1
        Nb1Prov = Left$(Nb1, P1 - 1)
    End If
    If P2 > 0 Then
        PS2 = L2 - P2
        Nb2Prov = Left$(Nb2, P2 - 1)
    End If
    If PS1 > PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
      ElseIf PS1 < PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2)
      Else
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
    End If
    'Retrouve les bonnes longueurs
    L1 = Len(Nb1): L2 = Len(Nb2)
    'Trouve la bonne position de la décimale du résultat
    Virgule = IIf(PS2 > PS1, PS2, PS1)
  
'Comparaison des termes si soustraction
If S1 <> S2 Then
Dim Pgdd As Long, Lmax As Long
'Renvoi 1 si Nb1>Nb2, sinon -1 ou Revoi 0 si égalité avec Nb1 et Nb2 >=0
Lmax = L1
If L1 < L2 Then Lmax = L2
Pgdd = StrComp(String$(Lmax - L1, Z) & Nb1, String$(Lmax - L2, Z) & Nb2)
If Pgdd = 0 Then AGN = "0": Exit Function 'égalité
End If
  
'Transformation en longueur multiple de Multiple
Dim Multiple As Long
Multiple = 14

Dim lgmul As Long
lgmul = (IIf(L1 < L2, L2, L1) \ Multiple + 1) * Multiple
Nb1 = String$(lgmul - L1, Z) & Nb1
Nb2 = String$(lgmul - L2, Z) & Nb2

'Variables
Dim Total As String
Dim t As Long
Dim V1 As Double, V2 As Double, R As Double, Ret As Long
Dim lr As Long
Dim ln10 As Double
ln10 = Log(10)
    
'Déclare le résultat à la longueur maxi
Total = String$(lgmul, Z)

'Fait l'opération puis met en forme
If S1 = S2 Then
    'Addition
    For t = lgmul - Multiple + 1 To 1 Step -Multiple
        V1 = Mid$(Nb1, t, Multiple)
        V2 = Mid$(Nb2, t, Multiple)
        R = V1 + V2 + Ret
        lr = Fix(Log(R + 0.11) / ln10) + 1
        If lr = Multiple + 1 Then Ret = 1 Else Ret = 0
        Mid$(Total, t - lr + Multiple, lr) = CStr(R)
    Next t
    'Replacement de la virgule
    If Virgule <> 0 Then Total = Left$(Total, Len(Total) - Virgule) & "," & Right$(Total, Virgule)
    'Mise en forme
    AGN = ZeroGN(Total)
    'Règle des signes
    If S1 = -1 And AGN <> "0" Then AGN = "-" & AGN
Else
    'Soustraction
    Dim Base As Double
    Base = 10 ^ (Multiple + 1)
    For t = lgmul - Multiple + 1 To 1 Step -Multiple
        V1 = Mid$(Nb1, t, Multiple)
        V2 = Mid$(Nb2, t, Multiple)
        R = V1 - V2 + Ret
        Ret = 0
        If Sgn(R) <> Pgdd And R <> 0 Then
            R = Pgdd * Base + R
            Ret = -Pgdd
        End If
        lr = Fix(Log(Abs(R) + 0.11) / ln10) + 1
        Mid$(Total, t - lr + Multiple, lr) = CStr(Abs(R))
    Next t
    'Replacement de la virgule
    If Virgule <> 0 Then Total = Left$(Total, Len(Total) - Virgule) & "," & Right$(Total, Virgule)
    'Mise en forme
    AGN = ZeroGN(Total)
    'Règle des signes
    If Pgdd * S1 = -1 Then AGN = "-" & AGN
End If

End Function

'=========================

 Function ZeroGN(ByVal Term1 As String) As String
'RETIRE LES ZEROS INUTILES

'Boucle de recherche des zéros inutiles dans la partie entière
Dim I As Long
For I = 1 To Len(Term1)
    If Mid$(Term1, I, 1) <> "0" Then Exit For
Next I
Term1 = Mid$(Term1, I)
If Term1 = vbNullString Then Term1 = "0" 'traite le cas d'un nombre nul

'Recherche si virgule
Dim V As Long
V = InStr(1, Term1, ",") + InStr(1, Term1, ".")

'Recherche si Term1<1, si oui remet un zéro devant la virgule
If V = 1 Then Term1 = "0" & Term1: V = 2

'Boucle de recherche des zéros inutiles dans partie décimale
If V > 0 Then
For I = Len(Term1) To V - 1 Step -1
    If Mid$(Term1, I, 1) <> "0" Then Exit For
Next I
Term1 = Left$(Term1, I)
End If

'Recherche si dernier=virgule, si oui=supprime
If V = Len(Term1) Then Term1 = Left$(Term1, V - 1)

'Renvoi
ZeroGN = Term1

End Function

'=========================

Function FactGN(ByVal a As Long, Optional b As Variant = 2) As String
'CALCUL FACTORIELLE

'Traitement option : B=1er nb de départ
b = CLng(b)

'Traitement des cas triviaux
If a < 0 Then FactGN = "#VALEUR!": Exit Function
If a = 0 Then FactGN = 1: Exit Function

'Variables
Dim Base As Double, P As Double, Q As Double
Dim N As Long, J As Long, I As Long
Dim Expo As Long

'Base dynamique optimisée
Expo = 15 - Len(Trim(Str$(a))) 'évite P>10^15 et donc le formattage exponentiel (1E15) !!

'Base de calcul
Base = 10 ^ Expo

'Nombre d'indice dans la base
N = Int((0.92 + (a + 0.5) * Log(a) - a) / Log(10)) + 1 'nb chiffre de A!
N = Int(N / Expo) + 1

'Déclaration des indices
ReDim t(N) As Double
t(0) = 1

'Algorithme factorielle
For J = b To a
    For I = 0 To N
        P = t(I) * J + Q
        Q = Int(P / Base)
        t(I) = P - Q * Base
    Next I
Next J

'Rajoute les zeros devant les indices moins long que expo
Dim Z As String 'optimisation string$
Z = "0"
Dim ln10 As Double
ln10 = Log(10)
For I = N To 0 Step -1
    FactGN = FactGN & String$(Expo - 1 - Fix(Log(t(I) + 0.11) / ln10), Z) & t(I)
Next I

'Supprime les zeros inutiles du début
FactGN = ZeroGN(FactGN)

End Function

'========================

Function ArrangGN(ByVal N As Long, ByVal P As Long) As String
'ARRANGEMENT de P objets avec N objets au total

If P > N Then ArrangGN = "#NOMBRE!": Exit Function
P = N - P + 1 'dernier indice dans l'algo factorielle
If P < 0 Then ArrangGN = "#VALEUR!": Exit Function
ArrangGN = FactGN(N, P)

End Function

'=========================

Function PGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'PRODUIT GRANDS NOMBRES

'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)

'Recherche des signes et conversion en nombre positif
Dim S1 As Long, S2 As Long
S1 = 1: S2 = 1
If Left$(Nb1, 1) = "-" Then S1 = -1: Nb1 = Right$(Nb1, L1 - 1): L1 = L1 - 1
If Left$(Nb2, 1) = "-" Then S2 = -1: Nb2 = Right$(Nb2, L2 - 1): L2 = L2 - 1

'Recherche de la décimale et conversion en entier
Dim P1 As Long, P2 As Long, Virgule As Long

    'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    If P1 > 0 Then
        Nb1 = Left$(Nb1, P1 - 1) & Right$(Nb1, L1 - P1)
        Virgule = L1 - P1
        L1 = L1 - 1
    End If
    If P2 > 0 Then
        Nb2 = Left$(Nb2, P2 - 1) & Right$(Nb2, L2 - P2)
        Virgule = Virgule + L2 - P2
        L2 = L2 - 1
    End If

'Découpage en tranche
Dim K1 As Long, K2 As Long, Kt As Long
K1 = L1 \ 7 + 1: K2 = L2 \ 7 + 1: Kt = K1 + K2

'Tableaux de stockage des tranches
ReDim a(K1) As Double, b(K2) As Double

'Remplissage tableau
Dim I As Long, J As Long

For I = 0 To K1 - 2
a(I) = Mid$(Nb1, L1 - 6 - I * 7, 7)
Next I
a(K1 - 1) = 0
If L1 Mod 7 <> 0 Then a(K1 - 1) = Left$(Nb1, L1 Mod 7)

For I = 0 To K2 - 2
b(I) = Mid$(Nb2, L2 - 6 - I * 7, 7)
Next I
b(K2 - 1) = 0
If L2 Mod 7 <> 0 Then b(K2 - 1) = Left$(Nb2, L2 Mod 7)

'Base de calcul
Dim Base As Long
Base = 10 ^ 7

'Déclaration des indices
ReDim t(Kt + 1) As Double

'Algo multiplication
Dim P As Double, Q As Double, K As Long, Saut As Long, L As Double
Saut = 90
For J = 0 To K1
    L = a(J)
    If J = Saut Then Saut = Saut + 90: GoSub Recalcul
    For I = 0 To K2
        t(I + J) = L * b(I) + t(I + J)
    Next I
Next J
GoSub Recalcul
GoTo suite:

Recalcul: 'recalculs des indices t() dans la Base avant dépassement de capacité
P = 0
For K = 0 To K2 + J
    Q = Int((t(K) + P) / Base)
    t(K) = t(K) + P - Q * Base
    P = Q
Next K
Return
suite:

'Rajoute les zeros dans les indices moins long que 7 chiffres
Dim Z As String 'optimisation string$
Z = "0"
Dim ln10 As Double
ln10 = Log(10)
For I = Kt To 0 Step -1
    PGN = PGN & String$(6 - Fix(Log(t(I) + 0.11) / ln10), Z) & t(I)
Next I

'Supprime les zeros inutiles
PGN = ZeroGN(PGN)

'Replacement de la virgule
Dim PS As Long
If Virgule <> 0 Then
    PS = Len(PGN) - Virgule
    If PS < 0 Then PGN = String$(-PS, Z) & PGN
    PGN = Left$(PGN, Len(PGN) - Virgule) & "," & Right$(PGN, Virgule)
End If

'Mise en forme
PGN = ZeroGN(PGN)

'Règle des signes
If S1 * S2 = -1 And PGN <> "0" Then PGN = "-" & PGN

End Function

'===============================
Function PuissanceGN(ByVal Nb1 As String, ByVal Expo As Long) As String
'PUISSANCE ENTIERE D'UN GRAND NOMBRE (décimal ou entier)

PuissanceGN = "1"
Do
    If Expo Mod 2 = 1 Then PuissanceGN = PGN(PuissanceGN, Nb1)
    Expo = Expo \ 2
    If Expo > 0 Then Nb1 = PGN(Nb1, Nb1)
Loop Until Expo = 0

End Function

'===============================

Function AbsGN(ByVal nb As String) As String
'Equivalent à ABS()
If Left$(nb, 1) = "-" Then AbsGN = Mid$(nb, 2) Else AbsGN = nb
End Function

'===============================

Function SgnGN(ByVal nb As String) As Long
'Equivalent à SGN()

nb = ZeroGN(nb)
If nb = "0" Then SgnGN = 0: Exit Function
Dim premier As String * 1
premier = Left$(nb, 1)
Select Case premier
    Case "-"
        SgnGN = -1
    Case Else
        SgnGN = 1
End Select
End Function

'===============================

Function IntGN(ByVal nb As String) As String
'Equivalent à INT()

nb = ZeroGN(nb)
Dim P As Long, Signe As Long
P = InStr(nb, ",") + InStr(nb, ".")
If P = 0 Then IntGN = nb: Exit Function
Signe = SgnGN(nb)
Select Case Signe
    Case -1
        IntGN = AGN(Left$(nb, P - 1), "-1")
    Case Else
        IntGN = Left$(nb, P - 1)
End Select
End Function

'===============================

Function FixGN(ByVal nb As String) As String
'Equivalent à FIX()

nb = ZeroGN(nb)
Dim P As Long
P = InStr(nb, ",") + InStr(nb, ".")
If P = 0 Then FixGN = nb: Exit Function
FixGN = Left$(nb, P - 1)

End Function

'=========================

Function CompGN(ByVal Nb1 As String, ByVal Nb2 As String) As Long
'Renvoi 1 si Nb1>Nb2, sinon -1 ou Revoi 0 si égalité

'format sans zero inutile
Nb1 = ZeroGN(Nb1): Nb2 = ZeroGN(Nb2)

'Regarde le signe
Dim Signe1 As String * 1, Signe2 As String * 1, Inverse As Long
Signe1 = Left$(Nb1, 1): Signe2 = Left$(Nb2, 1): Inverse = 1
If Signe1 = "-" And Signe2 <> "-" Then CompGN = "-1": Exit Function
If Signe1 <> "-" And Signe2 = "-" Then CompGN = "1": Exit Function
If Signe1 = "-" And Signe2 = "-" Then Nb1 = AbsGN(Nb1): Nb2 = AbsGN(Nb2): Inverse = -1

'Définitions
Dim P1 As Long, P2 As Long, PS1 As Long, PS2 As Long
Dim Z As String 'optimisation pour les string$ qui suivent
Z = "0"

'Info sur les longueurs des termes
Dim L1 As Long, L2 As Long
L1 = Len(Nb1): L2 = Len(Nb2)
    
'Recherche emplacement de la virgule
    P1 = InStr(1, Nb1, ",") + InStr(1, Nb1, ".")
    P2 = InStr(1, Nb2, ",") + InStr(1, Nb2, ".")
    'Recompose en entier
    Dim Nb1Prov As String, Nb2Prov As String
    PS1 = 0: PS2 = 0
    If P1 > 0 Then
        PS1 = L1 - P1
        Nb1Prov = Left$(Nb1, P1 - 1)
    End If
    If P2 > 0 Then
        PS2 = L2 - P2
        Nb2Prov = Left$(Nb2, P2 - 1)
    End If
    If PS1 > PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
      ElseIf PS1 < PS2 Then
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2)
      Else
        Nb1 = Nb1Prov & Right$(Nb1, L1 - P1) & String$(PS2 - PS1, Z)
        Nb2 = Nb2Prov & Right$(Nb2, L2 - P2) & String$(PS1 - PS2, Z)
    End If
    
    'Retrouve les bonnes longueurs
    L1 = Len(Nb1): L2 = Len(Nb2)
    
    'Le maxi
    Dim Lmax As Long
    Lmax = L1
    If L1 < L2 Then Lmax = L2

'Comparaison
CompGN = Inverse * StrComp(String$(Lmax - L1, Z) & Nb1, String$(Lmax - L2, Z) & Nb2)
End Function

'=========================

Function MinGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'Renvoi le nb mini

If CompGN(Nb1, Nb2) = -1 Then
    MinGN = Nb1
Else
    MinGN = Nb2
End If

End Function

'=========================
Function MaxGN(ByVal Nb1 As String, ByVal Nb2 As String) As String
'Renvoi le nb maxi

If CompGN(Nb1, Nb2) = 1 Then
    MaxGN = Nb1
Else
    MaxGN = Nb2
End If

End Function


'=========================

Function ArrondiGN(ByVal nb As String, Optional ByVal Pos As Variant = 16) As String
'ARRONDI(nombre;no_chiffres)
'Equivalent à ARRONDI d'Excel

'supprime les zeros inutiles
nb = ZeroGN(nb)

'Recherche emplacement de la virgule
Dim P As Long
P = InStr(1, nb, ",") + InStr(1, nb, ".")

'Si entier alors rajoute une virgule
If P = 0 Then P = Len(nb) + 1: nb = nb & ",0"

'vérifie que partie entière assez long
If -Pos >= P Then ArrondiGN = "0": Exit Function

'transforme en nb sans virgule
If P > 0 Then nb = Left$(nb, P - 1) & Right$(nb, Len(nb) - P)

'dernier chiffre à retenir pour arrondi
Dim C As Long, a As String
C = Val(Mid$(nb, P + Pos, 1))
a = Str$(SgnGN(nb))

'coupe nb
nb = Left$(nb, P + Pos - 1)

'arrondi
If C >= 5 Then
    Dim ZeroDeb As String 'traite le cas du zero devant qui sera supprimé par AGN
    ZeroDeb = Left$(nb, 1)
    nb = AGN(nb, a)
    If ZeroDeb = "0" Then nb = "0" & nb
End If

'reconstruit le nb
If Len(nb) >= P Then
    ArrondiGN = Left$(nb, P - 1) & "," & Right$(nb, Len(nb) - P + 1)
Else
    Dim enplus As Long
    enplus = 0
    If -Pos = P - 1 And SgnGN(nb) = 1 Then enplus = 1
    If -Pos = P - 2 And SgnGN(nb) = -1 Then enplus = 1
    ArrondiGN = nb & String$(P - Len(nb) - 1 + enplus, "0")
End If

'supprime les zeros inutiles
ArrondiGN = ZeroGN(ArrondiGN)

End Function

'=========================

Function RndGN(Optional ByVal Deci As Variant = 16) As String
'Equivalent à Rnd + Randomize : renvoi nb dans [0;1[

'Traitement option
Deci = CLng(Deci)

'Initialisation série
Randomize Timer

'Déclaration
Dim bfin As Long, t As Long, NbRnd As String, Base As Double, nb As String
Base = 10 ^ 15

'Complète par série de 15 chiffres entiers aléatoires
bfin = Deci \ 15
NbRnd = Space$((bfin + 1) * 15)

'Fabrique le nb
For t = 0 To bfin
    nb = Trim$(Str$(Int(Rnd * Base)))
    Mid$(NbRnd, t * 15 + 1, 15) = String$(15 - Len(nb), "0") & nb
Next t
RndGN = "0," & NbRnd

'Arrondi à Deci et met en forme
RndGN = ZeroGN(ArrondiGN(RndGN, Deci))

End Function

'=========================

Function RndBorneGN(ByVal Borne1 As String, Borne2 As String, Optional ByVal Deci As Variant = 16) As String
'Renvoi un nb décimal entre deux bornes

'Traitement option
Deci = CLng(Deci)

'Fabrique un nb : RNDGN()*(b-a)+a
RndBorneGN = ArrondiGN(AGN(PGN(AGN(Borne2, InverseGN(Borne1)), RndGN(Deci + Len(Borne1) + Len(Borne2))), Borne1), Deci)

End Function

'=========================

Function InverseGN(ByVal nb As String) As String
'Inverse le signe d'un nb

If Left$(nb, 1) = "-" Then
    InverseGN = AbsGN(nb)
    Exit Function
Else
    InverseGN = "-" & nb
End If

End Function