dépassement de capacitéRésolu

Question

Salut tt le monde

j'ai un problème avec l'erreur 6 "dépassement de capacité"

Voila le code source

dim rib as string

---

---il ya des traitement concernat  le rib

---

rib = Val(rib)

ribinter = rib * 100

ribinter = ribinter Mod 97  --- ici l'erreur de dépassement de capacité

MsgBox ribinter


Merci de répondre

jmfmarques · Accepted Answer

Hé bé !

L'idée était la suivante : traiter, comme à l'école primaire, la division...
Que fait-on, en fait, à l'école primaire, sinon mettre au numérateur (à gauche), une chaîne de caractères et l'on traite ensuite en ayant chaque fois un reste et en "abaissant" un chiffre de plus, puis en recommençant jusqu'à la fin ...

Nous gardons ce principe en l'améliorant un peut toutefois : au lieu d'abaisser un chiffre seulement, vous allons les abaisser par groupes de chiffres et nous gagnerons du temps...

Nous avons une chaîne de 18 caractères représentant un nombre. Si ce nombre était multiplié par 100, celà se traduirait simplement par l'ajout de "00" à la fin de cette chaîne de caractères, n'est-ce pas ? ce qui ferait donc, in fine, une chaîne composée de 20 CARACTERES (LES 18 DE DEPART & "OO")

Parfait !
Scindons cette chaîne en 4 groupes de 5 caractères, traitons avec leur valeur et repassons le reste en chaîne de caractères à concaténer avec le groupe suivant !

Tout celà en hommage à Cristobal Colombo (ce cher Christophe Colomb, qui nous a bluffé avec un simple oeuf) ...

Code, donc :

Private Sub Command1_Click()
  rib = "081030007240026060" 'voilà notre chiffre
  rib = rib & "00"  'qu'in "multiplie alphabétiquement" par 100
  Dim valreste As Integer, reste As String
  For i = 1 To Len(rib) Step 5
    reste = reste & Mid(rib, i, 5)
    valreste = val(reste) Mod 97
    reste = Str(valreste)
  Next
  MsgBox reste
End Sub

Ouf ...
Tu dis...

vercomax · Answer

rib tu le déclares en tant que Int32 ?

car:
Le type valeur Int32 représente des entiers signés dont les valeurs sont comprises entre moins 2 147 483 648 et plus 2 147 483 647

et en + tu le multiplies par 100

enfin, il me semble que çà va pas là

jmfmarques · Answer

"Dim rib As String
'---
'---il ya des traitement concernat le rib
'---"


C'est exactement ce qu'ilo nous manque : ces traitements... pour savoir ce que contient, finalement (après traotement) rib !

et je n'aime pas du tout, en plus :
1) dim rib as string
suivi de
2) rib = Val(rib)

miamiaca · Answer

non , je suis obliger de déclarer le rib comme étant une chaine de caractère 
est aussi je suis obliger de le multiplier par 100
pour le rib il doit être composé de 18 chiffres

vercomax · Answer

en tous cas, je vois que le type décimal a utiliser:
Le type valeur Decimal représente des nombres décimaux dont les valeurs varient de plus 79 228 162 514 264 337 593 543 950 335 à moins 79 228 162 514 264 337 593 543 950 335.Le type valeur Decimal convient particulièrement pour les opérations de calculs financiers nécessitant un nombre important de chiffres intégraux et fractionnaires significatifs, sans erreurs d'arrondi.

miamiaca · Answer

Mais il n'existe pas Decimal dans vb6
vous voulez dire Double peut être

jmfmarques · Answer

"pour le rib il doit être composé de 18 chiffres"


alors on y va :

100000000000000000 * 100 = combien ?
Tu as essayé ? (je te le conseille....)

vercomax · Answer

non double c'est 64bits donc pas suffisant

miamiaca · Answer

ok on va utiliser le  variant 16octets

jmfmarques · Answer

Ah ?

miamiaca · Answer

j'ai utiliser un exemple : 081030007240026060
lorsque j'utilise "info express" de vb6 il m'affiche dans cette ligne
 rib = Val(rib)
8.1030007240026060E+16
c'est quoi ca

miamiaca · Answer

le type variant codé sur 16 octet

jmfmarques · Answer

Je crois que tu es en train de perdre ton temps, tout simplement ...

Peux-tu nous dire quel traitement tu veux effectuer sur la chaine de caractères rib et pourquoi ?
On trouvera probablement une autre solution que celle d'un calcul purement arithmétique sur la "valeur" de cette chaîne.

miamiaca · Answer

I- STRUCTURE NORMALISEE DE L’IDENTIFIANT BANCAIFE :
L’identifiant bancaire du titulaire du compte est normalisé sur 20 positions
numériques comme suit :

x x  x x x  x x x x x  x x  x x x x x x  x x
Position 1 et 2 : Code banque, sur deux positions numériques, délivré par la BCT
Position 3 ,4 et 5 : Code agence, sur trois positions numériques, délivré par la BCT
Position 6 7 8 9 10 11 12 13 14 15 16 17 18 : Numéro de compte, sur treize positions
numériques, délivré par la banque (si ce numéro comporte moins de 13 caractères, il
sera cadré à droite et complété par des zéros à gauche).
Positions 19 et 20 : Clé de contrôle sur deux positions numériques.
II- CALCUL DE LA CLE DE CONTROLE « MODULO 97 », DITE CLE RIB
1/- L’ensemble constitué dans l’ordre par le code banque, le code agence et le numéro
de compte forme un nombre « N » de 18 chiffres.
2/- Multiplier « N » par 100 = N’.
3/- Diviser N’ par 97.
4/- Soustraire le RESTE de cette division du nombre « 97 » le résultat de cette
soustraction représente la clé de contrôle dite clé RIB (la clé RIB ne peut prendre que
les valeurs de 01 à 97).

cs_casy · Answer

Es-tu sur de tes informations.

Tous les RIB que je possede, le code banque est sur 5 chiffres, le code agence sur 5 chiffres, , le compte sur 11

ça nous fait 21 chiffres auquels il faut rajouter 2 chiffres pour la clé

+ 2 lettres et 2 chiffre en tete pour obtenir le code IBAN

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

miamiaca · Answer

non non 
c'est le rib de Banque central de tunisie

cs_casy · Answer

mais je crois bien que le format est internationnal. En tout cas pour le code IBAN, le format est internationnal.

---- Sevyc64  (alias Casy) ----<hr size="2" width="100%" /># LE PARTAGE EST NOTRE FORCE #

miamiaca · Answer

oui je sais 
international bank account number

jmfmarques · Answer

Ouais...
J'ai bien l'impression que tu ne trouveras pas de solution informatique à la "chose", tout au moins à l'aide de VB uniquement.

Il va te falloir probablement trouver une solution mathématique (probablement via une recherche de factorisation, de pgcd et ppcd entre les 2 chiffre N et 97, etc...)

Je viens de tenter avec l'utilisation de logarithmes, mais me suis royalement cassé la figure... (chemin à ne pas suivre, donc...).

Avec VB6 uniquement, je ne vois hélàs personnellement aucune issue. Ne restent donc, peut-être,  que les Maths !

miamiaca · Answer

ok merci

jmfmarques · Answer

Bon (je fatigue...)

Je crois que je tiens un bout (en prenant le problème complètement à l'envers) . Il semble que j'y parvienne, mais :

1) le calcul est très lent (près de 150 secondes !)
2) le ventilo de refroidissement de mon processeur tourne rapidement à fond, ce qui montre que le processeur est sur-sollicité ....)

Je vais essayer de continuer ainsi demain, mais en tentant de trouver quelques feintes pour "faire de gros bons" au départ et "des bonds plus petits" au fur et à mesure que je me rapprocherai du "bout"...
Une autre fois : je suis maintenant fatigué. Celà devrait aller moins mal demain !
Bonne nuit !

Gobillot · Answer

il me semble que le decimal est sur 14 octets et non pas 16,
pourtant 12 octets utilisés (96 bits) et 29 chiffres possible
solution ultra simple avec le decimal
j'ai voulu voir si le Currency était capable de le faire
c'est la division qui pose problème, il faut donc procéder par soustractions.

    Dim rib As Currency
    Dim cod As Currency
   
'  attention à la virgule pour découper les 4 décimales
    rib = CCur("12345678901234,5678")
   
    cod = CCur("97000000000000")
    While cod > 0.001
       While rib > cod
          rib = rib - cod
          Text1 = rib
          DoEvents
          Wend
       cod = cod / 10
       Wend
   rib = rib * 1000000
   MsgBox rib - Int(rib / 97) * 97

Daniel

Gobillot · Answer

pour le decimal:

    Dim rib As Variant
   
    rib = CDec("123456789012345678")

    rib = rib * 100
    MsgBox rib - Int(rib / 97) * 97

Daniel

Gobillot · Answer

pour le Currency, oublie le Text1 et le DoEvents ~~Text1 = rib DoEvents~~ c'était pour le test, comme je procédais par soustraction de 0.0097, le résultat n'arrivais jamais sinon le résultat est quasi instantané. Daniel

jmfmarques · Answer

Bravo Gobillot,

Je n'avais pas pensé à ta deuxième solution.

Ta première solution était par ailleurs celle que j'avais commencé à faire tourner hier et en effet, ce matin, je m'apprétais comme toi à oter d'emblée 97000000000000 pour soulager mon processeur.


Cette nuit, avant de m'endormir, j'avais pensé à d'autres solutions qui auraient également fonctionné mais qui, maintenant, deviennent totalement inutiles : en utilisant une conjugaison des 2 faits suivants :

 (a + b)  mod x = a mod x + b mod x 
 et par ailleurs 

a * 10^x mod b = (a * 10^x mod b) mid b

Il ne restait alors qu'à décomposer en 2 groupes de 9 caractères et traiter le modulo du 1er (en le multipliant par 10^9) et d'y ajouter le modulo du second. puis, si ce modulo c était lui mêle supérieyr à b, extraire c mod b

Ta deuxième solution est bien plus simple

miamiaca · Answer

merci pour vous mais 
il ya un problème
quand j'utilise 
ce code:
Dim rib As Variant
   
    rib = CDec("123456789012345678")

    rib = rib * 100
    MsgBox rib - Int(rib / 97) * 97
il me renvoi un resultat faux
dans mon exemple l'ai le rib = 081030007240026060
donc il faut que la fonction renvoi   85
mais avec ce code il me renvoi 90

jmfmarques · Answer

Ouais ! on n'est pas sorti de l'auberge, là !
Ma deuxième méthode, qui fonctionne très bien à la main, plante également quand je passe à la puissance (vb ne peut suivre !)
Mais la vue de la mer vient de me donner une autre idée encore, que je vais essayer de mettre en oeuvre.
Je viendrai (réussite ou échec) en rendre compte dans quelques minutes......

jmfmarques · Answer

L'histoire est assez amusante, au bout du compte, et je me demande si cela ne vaudrait pas le coup de répéter ce genre de truc pour traiter la plupart des opérations (addition, soustraction, diviision, multiplication) appliquées à de très grands nombre...

Et si on en faisait un bon petit exemple ?

Gobillot · Answer

pourtant j'ai le bon résultat:

    Dim rib As Variant

  

    rib = CDec("081030007240026060")

    

    rib = rib * 100

'   MsgBox rib                      ' -->  8103000724002606000

'   MsgBox Int(rib / 97)            ' -->    83536089938171195

'   MsgBox Int(rib / 97) * 97       ' -->  8103000724002605915

    MsgBox rib - Int(rib / 97) * 97 ' -->                   85

Daniel

jmfmarques · Answer

Bonsoir Daniel...
Mai tu as tout-à-fait raison !

Je me suis fait avoir (j'ai cru sur parole, sans vérifier, Miamaca... et ai pensé bêtement que son erreur pouvait résulter de ce que le RIB commençait par un 0)...


Je me suis donc cassé la tête pour rien ....


Je viens de tester ton code avec le rib "à problème" de Mamiaca et ton résultat est bon ...

Gobillot · Answer

Salut jmf,
"Je me suis donc cassé la tête pour rien ...."
non, non j'ai apprécié ton code, il est valable, surtout qu'il est pas limité en nombre de caractères, c'est pas le cas pour le variant qui marche dans le cas ici présent mais ne marchera pas pour les très grand nombre.
je me suis amusé aussi avec le currency, il donne le même résultat, mais 5 fois moins rapide et difficile à mettre en oeuvre.
donc ton code peux servir de base pour les opérations sur les très grand nombre

Daniel

jmfmarques · Answer

Merci Daniel...
Etant à moitié corse (par ma mère) je déteste en effet faire des efforts non justifiés.
Mais tu as raison : en calculant "à la manuelle", aucune limitation... c'est vrai.

On s'y met alors ? (Pas trop à la fois) : pour les autres opérations ? (je sais que tu peux et tu sais que je peux)... on y va ?
On pourrait servir le tout dans... disons un mois (je suis vraiment à moitié corse  )

Gobillot · Answer

premier essai l'addition
déjà pas aussi évident 
je me simplifie la vie, 2 nombres entiers sous forme de chaîne et de même longueur
addtion par tranche de 5 en commençant par la fin
il faut trouver nb3 tel que nb3 = nb1 + nb2

    Dim nb1$, nb2$, nb3$, i&, t&, r&
    
    nb1 = "8580123456789012345678901"
    nb2 = "3115081030007240026060123"
    nb3 = ""
    
    r  = 0
    For i = Len(nb1) - 4 To 1 Step -5
        t = Val(Mid$(nb1, i, 5)) + Val(Mid$(nb2, i, 5)) + r
        r = t \ 100000
        t = t - r * 100000
        nb3 = Format$(t, "00000") & nb3
        Next
    i = i + 4
    If i > 0 Then
       t = Val(Mid$(nb1, 1, i)) + Val(Mid$(nb2, 1, i))
       Else
       t = 0
       End If
    t = t + r
    If t > 0 Then nb3 = t & nb3
    MsgBox nb3

Daniel

jmfmarques · Answer

Mais c'est fameux, Daniel !

Pour moi, à première analyse, il n'y a rien à retoucher !

Quand au fait que tu as choisi 2 chaines de longueuur identique, ma foi, ce n'est vraiment pas un problème, puiqu'il suffit de compléter la plus courte des deux par un nombre de "0" placer devant tels que ce nombre = len(lapluslongue) - len(lapluscourte)

exemple, donc :

    nb1 = "8580123456789012345678901"
    nb2 = "357"
    nb2 = String(Len(nb1) - Len(nb2), "0") & nb2

Et vas pas trop vite, hein... (tu vas me fatiquer...)

miamiaca · Answer

merciiiiiiiiii
beaucoup

jmfmarques · Answer

Bon (mais ce sera la dernière pour moi aujourd'hui... me faut me rrreposer...oun peu... hein ! )

voilà la division (me suis contenté de visiser un très grand par du "normal" :

Private Sub Command1_Click()
  rib = "12345678901234567890123456" 'voilà notre chiffre
  'à diviser par
  divi = 1227
  preci = 3  'ici notre précision de décimales (à déterminer à sa guise)
  Dim valreste As Integer, reste As String
  For i = 1 To Len(rib) Step Len(Str(divi))
    reste = reste & Mid(rib, i, Len(Str(divi)))
    valreste = val(reste) Mod divi
    resul = resul & val(reste) \ divi
    reste = Str(valreste)
  Next
  If reste > 0 Then
  resul = resul & "."
  For j = 1 To preci
    reste = Str(valreste) & "0"
    valreste = val(reste) Mod divi
    resul = resul & val(reste) \ divi
    reste = Str(valreste)
  Next j
  End If
  MsgBox resul
End Sub

jmfmarques · Answer

Aie !

Correction (pour éviter le calcul des retenues )

For i = 1 To Len(rib) Step Len(Str(divi)) + 1
    reste = reste & Mid(rib, i, Len(Str(divi)) + 1)

Gobillot · Answer

bon j'ai testé la division, le temps de rajouter les définitions
    Dim rib$, divi&, resul$, i&, j&, preci%

ça a l'air de marcher nickel
pour division avec 2 très grand nombres, ça va pas être coton

Daniel

Gobillot · Answer

correction pour la division:
Str() rajoute déjà un espace devant
pas oublier de rajouter les zéros devant resul
sauf à la fin où il ne reste plus que 3 chiffres (donc 329 et non pas 00329)

    rib = "1227206001901234567890113456"
    divi = 1227

    resul = 101678907152622567329.629      'manque des zéros
    resul = 1000167890710052622567329.629

For i = 1 To Len(rib) Step Len(Str(divi))
      reste = reste & Mid(rib, i, Len(Str(divi)))
      valreste = val(reste) Mod divi
      resul = resul & Format$(Val(reste) \ divi, "00000")   'sauf à la fin
      reste = Str(valreste)
  Next

Daniel

jmfmarques · Answer

Merci Daniel.

Je passerai demain à la multiplication...

Dis-donc, toi...
Quand nous aurons fini le tour (jusqu'à la limite possible, bien entendu.... car il va y avoir une limite)

On pourrait peut-être se mettre en contact par MP pour mettre en place, à deux, un outil demo perfectionné...
Si tu en es d'accord, il te sera ensuite possible de proposer une source à déposer...(et tu en serais le dépositaire)

Dès que les choses commenceront à être bien précisées, je commencerais bien volontiers une interface à te soummettre en proposition.

Qu'en dis-tu ? 
J'ai essayré de trouver l'équivalent avec Google, sur VB, et n'ai rien trouvé ! Ce ne serait donc pas mal du tout....

Gobillot · Answer

la multiplication c'est facile, la division c'est autre chose: pour n1 et n2 de 1016 chiffres et precis = 1000, 172 ms avec des tableaux de Long et 125 ms avec des tableaux de Double. preci = 1000 nb1 = "+6859610553647623715964088665892371829439866709240283944117," & _ "9881257041327422001125735162772203142673516307553314590384" & _ "6660055334469068596105536476237159640886658923718294398667" & _ "0992402839441179812570413274220011257351627722031426735163" & _ "0775533145903846600553344690685961055364762371596408866589" & _ "2337182943986670924028394411798125704132742200112573516277" & _ "2220314267351630755331459038466005533446906859610553647623" & _ "7115964088665892371829439866709240283944117981257041327422" & _ "0001125735162772203142673516307553314590384660055334469068" & _ "5996105536476237159640886658923718294398667092402839441179" & _ "8112570413274220011257351627722031426735163075533145903846" & _ "6000553344690685961055364762371596408866589237182943986670" & _ "9224028394411798125704132742200112674526387320324368462731" & _ "8665332569149576116644556917950611664758624725074199775893" & _ "4882830449977810340293054227081367151338522001236745263873" & _ "2003243684627318653325691495761166445569179506116647586247" & _ "2550741997758934828304499778103402930542270813671513385220" & _ "012367452638732032436846273186" nb2 = "+7467636322858211413420378952487507706693561915417437336022," & _ "8558108410407266652454504706493231612117134305999525878380" & _ "1997265629154474676363228582114134203789524875077066935619" & _ "1554174373360228581084104072666524545047064932316121171343" & _ "0559995258783801972656291544746763632285821141342037895248" & _ "7550770669356191541743733602285810841040726665245450470649" & _ "3223161211713430599952587838019726562915447467636322858211" & _ "4113420378952487507706693561915417437336022858108410407266" & _ "6552454504706493231612117134305999525878380197265629154474" & _ "6776363228582114134203789524875077066935619154174373360228" & _ "5881084104072666524545047064932316121171343059995258783801" & _ "9772656291544746763632285821141342037895248750770669356191" & _ "5441743733602285810841040726665245551571749433261312724531" & _ "6009063598848010737672026558578647323968212413431379053598" & _ "5118717704662925428548446023968219411408376752565515717494" & _ "3332613127245316090635988480107376720265585786473239682124" & _ "1334313790535985187177046629254285484460239682194114083767" & _ "525655157174943326131272453160" MsgBox Division(nb1, nb2) Const param = 9 Const puis = 1000000000 Const frmt = "000000000" Const chrz = "0" Const sep = "," Dim preci As Integer 'nombre de chiffres significatifs maxi Dim pos As Integer Private Function Division(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim c As String Dim resu As String Dim sg As String Dim zero As String Dim a1 As Integer Dim a2 As Integer Dim b1 As Integer Dim b2 As Integer Dim di As Integer Dim dj As Integer Dim i As Long Dim j As Long Dim k As Integer Dim r As Integer Dim n As Integer Dim p As Integer Dim puis2 As Long Dim q As Integer Dim v1 As Long Dim v2 As Long Dim x As Integer Dim z As Integer Dim W1() As Long Dim W2() As Long If Mid$(n2, 2) = chrz Then Err.Raise 11 i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i k = k + param - (k Mod param) a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz) b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-" di = di + 1 pos = pos + dj puis2 = puis \ 10 z = k \ param ReDim W1(z), W2(z) i = 1 For j = k + 1 - param To 1 Step -param W1(i) = CLng(Mid$(a, j, param)) W2(i) CLng(Mid$(b, j, param)): i i + 1 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next If dj > 0 Then If x = -1 Then dj = dj + 1 r = 0 For j = 1 To z v1 = W1(j) W1(j) = (v1 Mod puis2) * 10 + r r = v1 \ puis2 Next End If resu = "0," & String$(dj - 1, chrz) p = 1: GoTo Boucle2 End If If x = 0 Then resu = "1" & String$(di - 1, chrz): GoTo Fin End If If x = -1 Then If di > 1 Then r = 0 For j = z To 1 Step -1 v1 = W2(j) W2(j) = v1 \ 10 + r * puis2 r = v1 Mod 10 Next di = di - 1 Else r = 0 For j = 1 To z v1 = W1(j) W1(j) = (v1 Mod puis2) * 10 + r r = v1 \ puis2 Next resu = resu & "0," p = 1: GoTo Boucle2 End If End If Boucle1: For q = 1 To di x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = n + 1 Wend If q < di Then r = 0 For j = z To 1 Step -1 v1 = W2(j) W2(j) = v1 \ 10 + r * puis2 r = v1 Mod 10 Next Else ' permet d'avoir le modulo: ' j = 1 ' For i = z To 1 Step -1' Mid$(a, j, param) Format$(W1(i), frmt): j j + param ' Next End If resu = resu & n Next If preci > di Then resu = resu & sep r = 0 For j = 1 To z v1 = W1(j) W1(j) = (v1 Mod puis2) * 10 + r r = v1 \ puis2 Next Boucle2: ' If pos = 0 Then ' Modulo = a$ ' Else ' Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos) ' End If dj = preci - di + p zero = String$(k, 48) For q = 1 To dj x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = n + 1 Wend If q < dj Then resu = resu & n x = 0 For j = 1 To z If W1(j) > 0 Then x = 1: Exit For Next If x = 0 Then For i = Len(resu) To di + 2 Step -1 If Mid$(resu, i, 1) <> chrz Then Exit For Next If i di + 1 Then i di resu = Left$(resu, i) GoTo Fin End If Else If n > 0 Then resu = resu & n GoTo Fin End If r = 0 For j = 1 To z v1 = W1(j) W1(j) = (v1 Mod puis2) * 10 + r r = v1 \ puis2 Next Next Fin: Division = sg & resu End Function Daniel

Gobillot · Answer

pas mal de modifications depuis: j'ai maintenant 2 modules ( a et b) le premier travaille en Long, le second en Double bien que le Double est plus lent, je peux mettre plus de chiffres, 7 pour la multiplication au lieu de 4, et 14 pour les autres opérations au lieu de 9, donc le Double devient plus rapide. la Fonction Arrondi permet de tronquer au nombre de chiffres significatifs (sauf si Tronq = False) elle est utilisée par toutes les opérations sauf la division (qui elle calcule un chiffre en plus pour permettre l'arrondi) ce qui permet d'avoir des résultats "exacts" retrouver le dividende en multipliant par le quotient: (20 / 9) * 9 = 20 l'inverse de l'inverse doit donner le même nombre: (1 / (1 / 9) --> 9 la Division donne en prime le Modulo (en réel) et le Modulo donne en prime le quotient entier. je donne tout le module b plus quelques publics du module a j'espère avoir rien oublié il y a encore pas mal de choses à revoir, par exemple la division qui donne parfois beaucoup trop de zéro aprés la virgule Option Explicit Const chrz = "0" Const sep = "," Dim parm As Integer Dim puis As Double Dim frmt As String Dim s1 As Byte Dim s2 As Byte Dim a1 As Integer Dim a2 As Integer Dim b1 As Integer Dim b2 As Integer Dim k As Integer Public preci As Integer Public pos As Integer Public Modulo As String Public Quotient As String Public Tronq As Boolean Public Function bAddition(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim i As Integer Dim j As Integer Dim x As Integer parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j k = k + parm - (k Mod parm) a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz) b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2) If s1 <> s2 Then x = StrComp(a, b, vbBinaryCompare) Select Case x Case 1: bAddition = bSbb(a, b, s1) Case 0: bAddition = "+0" Case -1: bAddition = bSbb(b, a, s2) End Select Exit Function End If bAddition = bAdd(a, b, s1) End Function Public Function bSoustraction(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim i As Integer Dim j As Integer Dim x As Integer parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j k = k + parm - (k Mod parm) a = String$(k - i, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1, chrz) b = String$(k - j, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2, chrz) s1 Asc(n1): s2 Asc(n2) If s1 <> s2 Then bSoustraction = bAdd(a, b, s1) Exit Function End If If s1 43 Then s2 45 Else s2 = 43 x = StrComp(a, b, vbBinaryCompare) Select Case x Case 1: bSoustraction = bSbb(a, b, s1) Case 0: bSoustraction = "+0" Case -1: bSoustraction = bSbb(b, a, s2) End Select End Function Private Function bAdd(n1 As String, n2 As String, sg As Byte) As String Dim c As String Dim i As Integer Dim j As Integer Dim x As Integer Dim r As Long Dim t As Double parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) k = Len(n1) c = String$(k, chrz) For i = k + 1 - parm To 1 Step -parm t = CDbl(Mid$(n1, i, parm)) + CDbl(Mid$(n2, i, parm)) + r r = 0: If t >= puis Then r = 1: t = t - puis Mid$(c, i, parm) = Format$(t, frmt) Next bAdd = Arrondi(c$, Chr$(sg)) End Function Private Function bSbb(n1 As String, n2 As String, sg As Byte) As String Dim c As String Dim i As Integer Dim j As Integer Dim x As Integer Dim r As Long Dim t As Double Dim v1 As Double Dim v2 As Double k = Len(n1) c = String$(k, chrz) For i = k + 1 - parm To 1 Step -parm v1 = CDbl(Mid$(n1, i, parm)) v2 CDbl(Mid$(n2, i, parm)) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 t = v1 - v2 Mid$(c, i, parm) = Format$(t, frmt) Next bSbb = Arrondi(c$, Chr$(sg)) End Function Public Function bMultiplication(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim d As String Dim sg As String Dim i As Long Dim j As Long Dim ka As Integer Dim kb As Integer Dim x As Integer Dim y As Integer Dim z As Integer Dim r As Long Dim tt As Double Dim v1 As Double Dim v2 As Double Dim W1() As Double Dim W2() As Double parm = 7 puis = 10 ^ parm frmt = String(parm, chrz) i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 pos = b1 + b2 If Asc(n1) Asc(n2) Then sg "+" Else sg = "-" i a1 + b1: x parm - (i Mod parm): If x = parm Then x = 0 j a2 + b2: y parm - (j Mod parm): If y = parm Then y = 0 a = String$(y, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) b = String$(x, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) ka y + j: kb x + i x kb \ parm: k ka + kb: z = k \ parm ReDim W1(x), W2(z) i = 1 For j = kb + 1 - parm To 1 Step -parm W1(i) CDbl(Mid$(b, j, parm)): i i + 1 Next y = 0 For i = ka + 1 - parm To 1 Step -parm v1 = CDbl(Mid$(a, i, parm)) r = 0 For j = 1 To x tt = W1(j) * v1 + W2(j + y) + r r = Int(tt / puis) W2(j + y) = tt - r * puis Next W2(j + y) = r y = y + 1 Next d$ = String(k, chrz) j = 1 For i = z To 1 Step -1 Mid$(d$, j, parm) Format$(W2(i), frmt): j j + parm Next bMultiplication = Arrondi(d$, sg) End Function Public Function bDivision(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim c As String Dim resu As String Dim sg As String Dim di As Integer Dim dj As Integer Dim i As Long Dim j As Long Dim r As Integer Dim n As Integer Dim p As Integer Dim puis2 As Double Dim q As Integer Dim v1 As Double Dim v2 As Double Dim x As Integer Dim z As Integer Dim W1() As Double Dim W2() As Double If Mid$(n2, 2) = chrz Then Err.Raise 11 parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) puis2 = puis / 10 i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i k = k + parm - (k Mod parm) a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz) b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-" di = di + 1 pos = pos + dj z = k \ parm ReDim W1(z), W2(z) ' et W3(z) i = 1 For j = k + 1 - parm To 1 Step -parm W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1 Next ' x = StrComp(a, b, vbBinaryCompare) x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next If dj > 0 Then If x = -1 Then dj = dj + 1 ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next End If resu = "0," & String$(dj - 1, chrz) p = 1: GoTo Boucle2 End If If x = 0 Then resu = "1" & String$(di - 1, chrz): GoTo Fin End If If x = -1 Then If di > 1 Then ' b$ = "0" & Left$(b$, k - 1) r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next di = di - 1 Else ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next resu = resu & "0," p = 1: GoTo Boucle2 End If End If Boucle1: For q = 1 To di x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = n + 1 Wend If q < di Then ' b$ = "0" & Left$(b$, k - 1) r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next End If resu = resu & n Next If preci + 1 > di Then resu = resu & sep j = 1 For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm Next ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next Boucle2: If pos = 0 Then Modulo = a$ Else Modulo = Left$(a$, k - pos) & sep & Right$(a$, pos) End If dj = preci + 1 - di + p For q = 1 To dj ' x = StrComp(a, b, vbBinaryCompare) x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = n + 1 Wend If q < dj Then resu = resu & n x = 0 For j = 1 To z If W1(j) > 0 Then x = 1: Exit For Next If x = 0 Then For i = Len(resu) To di + 2 Step -1 If Mid$(resu, i, 1) <> chrz Then Exit For Next If i di + 1 Then i di resu = Left$(resu, i) GoTo Fin End If Else If n > 0 Then resu = resu & n GoTo Fin End If ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next Next Fin: bDivision = sg & resu End Function Public Function bModulo(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim c As String Dim resu As String Dim sg As String Dim di As Integer Dim dj As Integer Dim i As Long Dim j As Long Dim r As Integer Dim n As Integer Dim p As Integer Dim puis2 As Double Dim q As Integer Dim v1 As Double Dim v2 As Double Dim x As Integer Dim z As Integer Dim W1() As Double Dim W2() As Double If Mid$(n2, 2) = chrz Then Err.Raise 11 parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) puis2 = puis / 10 i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i k = k + parm - (k Mod parm) a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz) b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg "+" Else sg = "-" di = di + 1 pos = pos + dj z = k \ parm ReDim W1(z), W2(z) ' et W3(z) i = 1 For j = k + 1 - parm To 1 Step -parm W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1 Next ' x = StrComp(a, b, vbBinaryCompare) x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next If dj > 0 Then If x = -1 Then dj = dj + 1 ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next End If resu = "0": GoTo Fin End If If x = 0 Then resu = "1" & String$(di - 1, chrz): GoTo Fin End If If x = -1 Then If di > 1 Then ' b$ = "0" & Left$(b$, k - 1) r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next di = di - 1 Else ' a$ = Mid$(a$, 2) & "0" r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next resu = resu & "0": GoTo Fin End If End If Boucle1: For q = 1 To di x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For j = z To 1 Step -1 If W1(j) < W2(j) Then x = -1: Exit For If W1(j) > W2(j) Then x = 1: Exit For Next n = n + 1 Wend If q < di Then ' b$ = "0" & Left$(b$, k - 1) r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next End If resu = resu & n Next j = 1 For i = z To 1 Step -1 Mid$(a$, j, parm) Format$(W1(i), frmt): j j + parm Next Fin: Quotient = sg & resu sg = Left$(n1, 1) bModulo = Arrondi(a$, sg) End Function Private Function Arrondi(a As String, sg As String) As String Dim i As Integer Dim j As Integer Dim x As Integer Dim r As Long Dim t As Double Dim z As Integer x = k + 1 - pos ' suppression des zéros devant For i = 1 To x - 2 If Mid$(a$, i, 1) <> chrz Then Exit For Next ' suppression des zéros derrière For j = k To x Step -1 If Mid$(a$, j, 1) <> chrz Then Exit For Next a1 = x - i b1 = j + 1 - x If Tronq Then b2 preci - a1: If b2 < 0 Then b2 0 If b2 < b1 Then If Mid$(a$, x + b2, 1) > "4" Then z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm j = z% - j + 1 r = 10 ^ ((k - z%) Mod parm) While r > 0 t = CDbl(Mid$(a$, j, parm)) + r r = 0 If t >puis Then r 1: t = t - puis Mid$(a$, j, parm) = Format$(t, frmt) j = j - parm Wend End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1 For j = x + b2 - 1 To x Step -1 If Mid$(a$, j, 1) <> chrz Then Exit For Next b1 = j + 1 - x End If End If Arrondi = sg & Mid$(a$, i, a1) If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1) End Function Daniel

Gobillot · Answer

voici la nouvelle division modifiée, elle utilise maintenant Arrondi comme les autres opérations. quelques bugs ont été corrigés dans Arrondi() et en plus une autre opération a été ajoutée calcul de racine carrée: - première estimation en Double avec un maximum de chiffres j'avais adapté la méthode John Carmak, mais elle était pas assez performante je sais pas si vous connaissez le nombre magique &H5F3759DF (ou &H5F375A86) pourtant simple à adapter en VB6 mais jamais trouvé sur le net: Dim i As Long Dim x As Single Dim z As Single CopyMemory i, x, 4& i = &H5F375A86 - i / 2 CopyMemory z, i, 4& Racine = z * x - transformation en chaîne de cette estimation: là aussi aucune instruction Format n'a été capable d'afficher tous les chiffres et en plus il y avait dépassement de capacité en multipliant par une puissance de 10 trop grande - ensuite calcul jusqu'à la précision demandée par itération en utilisant la méthode de Héron x = ( n/x + x ) /2 '2 constantes en plus Const sg1 = "+" Const sg2 = "-" Public Function bDivision(n1 As String, n2 As String) As String Dim a As String Dim b As String Dim c As String Dim resu As String Dim sg As String Dim di As Integer Dim dj As Integer Dim i As Integer Dim j As Integer Dim n As Integer Dim p As Integer Dim puis2 As Double Dim q As Integer Dim r As Integer Dim v1 As Double Dim v2 As Double Dim x As Integer Dim z As Integer Dim W1() As Double Dim W2() As Double If Mid$(n2, 2) = chrz Then Err.Raise 11 parm = 14 puis = 10 ^ parm frmt = String(parm, chrz) puis2 = puis / 10 i = InStr(n1, sep) j = InStr(n2, sep) If i > 0 Then a1 i - 2: b1 Len(n1) - i Else a1 = Len(n1) - 1: b1 = 0 If j > 0 Then a2 j - 2: b2 Len(n2) - j Else a2 = Len(n2) - 1: b2 = 0 If b1 > b2 Then pos b1 Else pos b2 i = a1 + pos j = a2 + pos If i > j Then k i Else k j di k - j: dj k - i k = k + parm - (k Mod parm) a = String$(k - i - dj, chrz) & Mid$(n1, 2, a1) & Mid$(n1, a1 + 3, b1) & String$(pos - b1 + dj, chrz) b = String$(k - j - di, chrz) & Mid$(n2, 2, a2) & Mid$(n2, a2 + 3, b2) & String$(pos - b2 + di, chrz) If Asc(n1) Asc(n2) Then sg sg1 Else sg = sg2 di = di + 1 pos 0: z k \ parm ReDim W1(z), W2(z) i = 1 For j = k + 1 - parm To 1 Step -parm W1(i) = CDbl(Mid$(a, j, parm)) W2(i) CDbl(Mid$(b, j, parm)): i i + 1 Next x = 0 For k = z To 1 Step -1 If W1(k) < W2(k) Then x = -1: Exit For If W1(k) > W2(k) Then x = 1: Exit For Next If dj > 0 Then If x = -1 Then dj = dj + 1 r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next End If pos = dj - 1 p = 1: GoTo Boucle2 End If If x = 0 Then resu = "1" & String$(di - 1, chrz): GoTo Fin End If If x = -1 Then If di > 1 Then r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next di = di - 1 Else r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next p = 1: GoTo Boucle2 End If End If Boucle1: For q = 1 To di x = 0 For k = z To 1 Step -1 If W1(k) < W2(k) Then x = -1: Exit For If W1(k) > W2(k) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For k = z To 1 Step -1 If W1(k) < W2(k) Then x = -1: Exit For If W1(k) > W2(k) Then x = 1: Exit For Next n = n + 1 Wend If q < di Then r = 0 For j = z To 1 Step -1 v1 = W2(j) v2 = Int(v1 / 10) W2(j) = v2 + r * puis2 r = v1 - v2 * 10 Next End If resu = resu & n Next r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next Boucle2: dj = preci + 1 - di + p For q = 1 To dj x = 0 For k = z To 1 Step -1 If W1(k) < W2(k) Then x = -1: Exit For If W1(k) > W2(k) Then x = 1: Exit For Next n = 0 While x <> -1 For i = 1 To z v1 = W1(i) v2 W2(i) + r: r 0 If v1 < v2 Then v1 v1 + puis: r 1 W1(i) = v1 - v2 Next x = 0 For k = z To 1 Step -1 If W1(k) < W2(k) Then x = -1: Exit For If W1(k) > W2(k) Then x = 1: Exit For Next n = n + 1 Wend resu resu & n: pos pos + 1 If q < dj Then For k = 1 To z If W1(k) > 0 Then r = 0 For j = 1 To z v1 = W1(j) v2 = Int(v1 / puis2) W1(j) = (v1 - v2 * puis2) * 10 + r r = v2 Next Exit For End If Next Else q = dj End If Next Fin: q = Len(resu) k = q + parm - (q Mod parm) a$ = String$(k - q, chrz) & resu bDivision = Arrondi(a$, sg) End Function Private Function Arrondi(a As String, sg As String) As String Dim i As Integer Dim j As Integer Dim x As Integer Dim r As Double Dim t As Double Dim z As Integer x = k + 1 - pos For i = 1 To k If Mid$(a$, i, 1) <> chrz Then Exit For Next For j = k To x Step -1 If Mid$(a$, j, 1) <> chrz Then Exit For Next a2 = x - i If a2 > 0 Then a1 a2 Else a1 1: i = x - 1 b1 = j + 1 - x If Tronq Then b2 preci - a2: If b2 < 0 Then b2 0 If b2 < b1 Then If Mid$(a$, x + b2, 1) > "4" Then z% = x + b2 - 1 j z% Mod parm: If j 0 Then j = parm j = z% - j + 1 r = 10 ^ ((k - z%) Mod parm) While r > 0 t = CDbl(Mid$(a$, j, parm)) + r r = 0 If t >puis Then r 1: t = t - puis Mid$(a$, j, parm) = Format$(t, frmt) j = j - parm Wend End If If Mid$(a$, i - 1, 1) <> chrz Then i i - 1: a1 a1 + 1 For j = x + b2 - 1 To x Step -1 If Mid$(a$, j, 1) <> chrz Then Exit For Next b1 = j + 1 - x End If End If Arrondi = sg & Mid$(a$, i, a1) If b1 > 0 Then Arrondi = Arrondi & sep & Mid$(a$, x, b1) End Function Public Function bRacine(n1 As String) As String Dim a As String Dim b As String Dim c As String Dim ex As Integer Dim i As Integer Dim j As Integer Dim x As Integer Dim W1 As Double Dim W2 As Double If Asc(n1) = 45 Then Err.Raise 5 i = InStr(n1, sep) If i > 0 Then a1 i - 2 Else a1 Len(n1) - 1 If a1 < 16 Then k% 0: W1 CDbl(n1) Else If (a1 And 1) 0 Then b2 15 Else b2 = 16 k% (a1 - b2 + 1) \ 2: W1 CDbl(Left$(n1, b2)) End If W2 = Sqr(W1) c$ = Format$(W2, "###############E+") ex = Mid$(c$, 17) + k If ex >= 0 Then a1 15: a2 ex: x = 0 Else ex = -ex If ex >= 15 Then a1 0: a2 1: b1 = ex - 15 Else a1 15 - ex: a2 0: b1 = 0 End If For i = 15 To a1 + 1 Step -1 If Mid$(a$, i, 1) <> "0" Then Exit For Next b2 i - a1: x b1 + b2 End If a$ = sg1 & Left$(c$, a1) & String$(a2, chrz) If x Then a$ = a$ & sep & String$(b1, chrz) & Mid$(c$, a1 + 1, b2) c$ = "+2" x = 1 Do b$ = a$ a$ = bDivision(n1, b$) a$ = bAddition(a$, b$) a$ = bDivision(a$, c$) x = StrComp(a$, b$) Loop Until x = 0 bRacine = a$ End Function Daniel

Dépassement de capacité

43 réponses

Votre réponse

Discussions similaires