XL 2016 Transformer un grand nombre format texte en numérique

philppe27

XLDnaute Occasionnel
Bonjour à tous,
Je rencontre un problème pour transformer un grand nombre en format texte en format numérique.
En effet, au delà d'une certaine valeur la fonction cnum arrondi mon nombre numérique (voir fichier ci joint).
Merci d'avance pour votre aide afin d'obtenir la valeur précise.
 

Pièces jointes

  • test1.xlsx
    9.2 KB · Affichages: 22

Dranreb

XLDnaute Barbatruc
Bonjour.
Excel ne travaille qu'avec un seul type de représentation numérique interne: les nombres binaires en virgule flottante double précision.
Celui ci convient parfaitement pour l'immense majorité des applications, encore qu'il faille parfois se méfier un peu des décimales affichées.
Voici quelque fonctions persos, à mettre dans un module standard, permettant de vérifier les vraies valeurs numériques de vos cellules tel qu'il faudrait les exprimer en décimal pour être tout à fait exact.
VB:
Option Explicit
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
   (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Function TxtDécimal(ByVal V As Double) As String
   Dim E#, D#, Q#, R#, M#, Nég As Boolean
   If V = 0 Then TxtDécimal = "0": Exit Function
   Nég = V < 0: V = Abs(V)
   E = Int(V): D = V - E
   Do: M = Modulo10(E): TxtDécimal = M & TxtDécimal: E = (E - M) / 10: Loop Until E = 0
   If Nég Then TxtDécimal = "-" & TxtDécimal
   If D = 0 Then Exit Function
   TxtDécimal = TxtDécimal & ","
'   Do While D > 0: D = 10 * D: M = Int(D): TxtDécimal = TxtDécimal & M: D = D - M: Loop ' pas bon: la multipliation par 10 peut perdre quelques bits
   Do While D > 0: M = Int(10 * D): TxtDécimal = TxtDécimal & M: D = (D - M / 10) * 10: Loop ' Décidément ce n'est toujours pas bon
   Do While D > 0: M = Int(10 * D): TxtDécimal = TxtDécimal & M: D = D * 8 - M + D * 2: Loop
   End Function
Private Function Modulo10(ByVal X As Double) As Long
   Dim Y As Double, E10 As Long
   Y = Int(X / 2): Modulo10 = X - 2 * Y: X = Y
   E10 = 1: Do While X > 0: Y = Int(X / 2)
      E10 = 2 * E10 Mod 10: Modulo10 = (Modulo10 + (X - 2 * Y) * E10) Mod 10
      X = Y: Loop
   End Function
Function TxtDécCodé(ByVal V As Double) As String
   Dim E2 As Long, Nég As Boolean, D As Double
   If V = 0 Then TxtDécCodé = "0": Exit Function
   CalcMtE2 V, E2, V: Nég = V < 0: V = Abs(V)
   While Int(V) <> V: V = 2 * V: E2 = E2 - 1: Wend
   If E2 >= 0 Then D = V * 2 ^ E2: If D < 1E+16 Then V = D: E2 = 0
   While V > 0: D = Int(V / 10): TxtDécCodé = V - 10 * D & TxtDécCodé: V = D: Wend
   If Nég Then TxtDécCodé = "-" & TxtDécCodé
   If E2 <> 0 Then TxtDécCodé = TxtDécCodé & " × 2": If E2 <> 1 Then TxtDécCodé = TxtDécCodé & "^" & E2
   End Function
Function DblMtE2(ByVal Mt As Double, ByVal E2 As Long) As Double
   Dim TIntg(0 To 3) As Integer
   If Mt = 0 Then DblMtE2 = 0: Exit Function
   MoveMemory TIntg(0), Mt, 8
   TIntg(3) = TIntg(3) + E2 * &H10
   MoveMemory DblMtE2, TIntg(0), 8
   End Function
Private Sub CalcMtE2(Mt As Double, E2 As Long, ByVal V As Double)
   Dim TIntg(0 To 3) As Integer
   If V = 0 Then Mt = 0: E2 = 0: Exit Sub
   MoveMemory TIntg(0), V, 8
   E2 = (TIntg(3) And &H7FF0) \ &H10 - &H3FF
   TIntg(3) = TIntg(3) And &H800F Or &H3FF0
   MoveMemory Mt, TIntg(0), 8
   End Sub
Edition: petite correction.
Edition 2: nouvelle correction
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonsoir.
Toujours pas bon, le code indiqué poste précédent. Se faisait régulièrement piéger à perdre des bits en multipliant par 10, même en prenant soin de ne multiplier que par 8 pour ne pas en perdre, retrancher ce qu'il y a à retrancher et après seulement compléter par le double. En effet ça ne marche pas quand il n'y a rien à retrancher…
J'ai tout refait différemment et je l'ai considérablement étoffé en un classeur destiner à faire prendre conscience au gens de la vraie nature du problème.
 

Pièces jointes

  • ValeursExcelVsVBA.xlsm
    81.1 KB · Affichages: 13

Discussions similaires

Réponses
7
Affichages
278

Statistiques des forums

Discussions
312 106
Messages
2 085 352
Membres
102 871
dernier inscrit
Maïmanko