XL 2019 Modification code créé en 2008 :-)

FaridP

XLDnaute Occasionnel
Bonjour à tous,

J'ai trouvé un excellent code créé en 2008 (rendons à chacun ce qui lui appartient) et c'est exactement ce que je recherche au détail près que je peux avoir jusqu'à 19 chiffres à récupérer et, quand c'est le cas, le nombre extrait est arrondi.

Exemple : 6198005050603430000 au lieu de 6198005050603427070

Voici le code :
VB:
Function ExtractNumber(rCell As Range, _
    Optional Take_decimal As Boolean, Optional Take_negative As Boolean) As Double
   
Dim iCount As Integer, i As Integer, iLoop As Integer
    Dim sText As String, strNeg As String, strDec As String
    Dim lNum As String
    Dim vVal, vVal2
   
     ''''''''''''''''''''''''''''''''''''''''''
     'Written by OzGrid Business Applications
     'www.ozgrid.com
   
     'Extracts a number from a cell containing text and numbers.
     ''''''''''''''''''''''''''''''''''''''''''
    sText = rCell
    If Take_decimal = True And Take_negative = True Then
        strNeg = "-" 'Negative Sign MUST be before 1st number.
        strDec = "."
    ElseIf Take_decimal = True And Take_negative = False Then
        strNeg = vbNullString
        strDec = "."
    ElseIf Take_decimal = False And Take_negative = True Then
        strNeg = "-"
        strDec = vbNullString
    End If
    iLoop = Len(sText)
       
            For iCount = iLoop To 1 Step -1
            vVal = Mid(sText, iCount, 1)
           
   
                If IsNumeric(vVal) Or vVal = strNeg Or vVal = strDec Then
                    i = i + 1
                    lNum = Mid(sText, iCount, 1) & lNum
                        If IsNumeric(lNum) Then
                            If CDbl(lNum) < 0 Then Exit For
                        Else
                          lNum = Replace(lNum, Left(lNum, 1), "", , 1)
                        End If
                End If
               
                If i = 1 And lNum <> vbNullString Then lNum = CDbl(Mid(lNum, 1, 1))
            Next iCount
       
   
    ExtractNumber = CDbl(lNum)
   
End Function

Ce n'est peut-être pas grand chose à changer dans le code mais je ne trouve pas donc quelqu'un pouvait soulager mon cerveau de ce supplice, ce serait génial. :p:)

Merci et bonne fin de journée à toutes et à tous,

Farid ;)

PS : Merci à Staple1600 qui me facilite grandement la tâche
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonjour le fil, Farid

•>FaridP
Petit préambule:
Merci de pas faire référence à mon pseudo dans le titre de ta discussion.
Donc merci de prendre le temps d'éditer le titre ;)

Et après on pourra causer de ce code de vieux 10 d'âge ;)
(mais point maturé dans un fut de chêne, comme un spiritueux écossais ou irlandais)

NB: Ce code n'est point de moi (comme on peut le lire dans le commentaire de la macro)
Seul le post de 2008 l'est.
 

FaridP

XLDnaute Occasionnel
Bonjour Staple1600,

Désolé, ça partait d'une bonne intention mais je comprends totalement que tu préfères que j'évite. C'est modifié dans le titre et le message. :)

Ton code est juste parfait pour résoudre mon souci, penses-tu que tu pourrais me dire ce que je dois modifier pour aller jusqu'à 19 chiffres sans arrondi ?

Merci pour ton aide et encore désolé pour la référence, ;)

Farid
 

Staple1600

XLDnaute Barbatruc
Re

Merci pour l'édition.
Maintenant, il y a plus simple pour faire ce que tu veux.
Et de mémoire, il doit y avoir dans les archives (plus récentes) du forum des questions/réponses similaires à ta problématique du jour.
Je pense à des réponses fournies par Dranreb (par exemple)
(cf aussi posts de job75, Modeste gee dee ou encore ROGER2327)
 
Dernière édition:

FaridP

XLDnaute Occasionnel
NB: Ce code n'est point de moi (comme on peut le lire dans le commentaire de la macro)
Seul le post de 2008 l'est.
Ah mince, effectivement je n'avais pas fait gaffe excité que je t'étais de m'approcher d'une solution finale.

Bon, bon, je vais continuer de me torturer mais je ne pense pas avoir les compétences nécessaires.

Je te renouvelle mes excuses et te remercie d'avoir pris le temps de me répondre. ;):)
 

Staple1600

XLDnaute Barbatruc
Re

Voici par exemple une discussion avec du bel ouvrage
Je te laisse trouver les autres ;)
 

Discussions similaires

Réponses
28
Affichages
921

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86