Extraction chiffre

Bonjour forum,

Voilà j'ai un petit souci dans mon fichier test j'ai fait une macro pour extraire que les chiffres mais il y a truc de bizarre vous verrez il y deux ligne qui on 240.000 et une a 105.000 et d'autre nombre plus petit.

Tout ce passe bien sauf que ceux qui ont 240.000 si je met 210.000 ça marche sinon ça bug a ces deux endroits là.

Alors merci de m'aider a comprendre

edit Dan : changé titre du sujet 'Bizarrerie d'excel. Merci de lire la charte du forum et lors des demande de mettre un titre qui explique la demande

19test.xlsm (17.55 Ko)

bonjour,

mettre :

Function extrait_chiffres(ByRef texto As String) As Double
'Le reste sans changement

A+

Bonjour,

Ce n'est pas une bizarrerie, la valeur d'un Long doit être comprise entre -2147483648 et 2147483647, quand tu concatène 240000 et 3000 tu as comme valeur 2400003000 donc tu dépasses la capacité d'un Long de 252519353. Il te faut déclarer ta fonction en Double et là, plus de problème.


Oups,

Pas rafraîchi entre temps

Ok merci ça marche mieux comme ça par contre je voudrais rajouter ça dedans car le 3 de groupe est en trop ou le 1 ou le 2 la dans l'exemple il y étais pas mais en faite ils y sont.

Sheets("Index").Columns("A").Replace "Groupe 3", "Groupe"

Sheets("Index").Columns("A").Replace "Groupe 2", "Groupe"

Sheets("Index").Columns("A").Replace "Groupe 1", "Groupe"


Oui c'est pour ça je comprenais pas mais que vu le code du replace ne fonctionnais pas bien un long suffisait en faite c'est pour ça si tu pouvais m'aider à bien le placer pour qu'il fonctionne ou un autre code

Bonjour,

A remplacer par ce code

Sub gauche()

Dim cptr As Byte
    For cptr = 1 To 9
        Sheets("index").Activate
        Sheets("Index").Columns("A").Replace "Groupe 3", "Groupe"
        Sheets("Index").Columns("A").Replace "Groupe 2", "Groupe"
        Sheets("Index").Columns("A").Replace "Groupe 1", "Groupe"

        Application.ScreenUpdating = False

        Cells(cptr, "A") = extrait_chiffres(Cells(cptr, "A"))
    Next

End Sub

ok merci ça marche nickel je voulais savoir si les deux code pouvais être regroupé dans la même macro gauche sub end ???

En faite le truc c'est que comme je met le as long qui devrais suffire il ne remplace plus le Groupe 3 par Groupe par contre quand je met le As Double il me remplace bien les mots Groupe mais il a pas supprimé le 3 du groupe donc pas bon bizarre non et donc ça donne une erreur avec le As long.

car j'ai un autre module pour ça le truc de la recherche déjà avec office 2007 c'est pas top en manuel apparemment c'étais un problème sur 2003 aussi

https://support.microsoft.com/fr-fr/kb/813978

bonjour

essayer ca

Sub gauche()
Dim cptr As Byte
Dim reg As Object
Dim extraction As Object
Dim drlg As Integer
Dim extrait_chiffres, texto As String 'As Double
drlg = Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("index")
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 3", "Groupe"
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 2", "Groupe"
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 1", "Groupe"
For cptr = 1 To drlg
texto = Cells(cptr, "A")
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
        reg.Pattern = "(\d?\d?\d)"
        Set extraction = reg.Execute(texto)
        For Each digit In extraction
        extrait_chiffres = extrait_chiffres & (digit.Value)
        Next digit
Set extraction = Nothing
Set reg = Nothing

.Cells(cptr, "A") = extrait_chiffres

Next
End With
End Sub
   

OK non ça fonctionne pas ça me met des 6,00002700600002E+83

essayer ca

il faut vider extrait_chiffres = 0 a chaque tour

Sub gauche()
Dim cptr As Byte
Dim reg As Object
Dim extraction As Object
Dim drlg As Integer
Dim extrait_chiffres As Double, texto As String '
drlg = Cells(Rows.Count, "A").End(xlUp).Row

With Sheets("index")
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 3", "Groupe"
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 2", "Groupe"
.Range("A" & 1 & ":A" & drlg).Replace "Groupe 1", "Groupe"
For cptr = 1 To drlg
texto = Cells(cptr, "A")
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
        reg.Pattern = "(\d?\d?\d)"
        Set extraction = reg.Execute(texto)
        For Each digit In extraction
       extrait_chiffres = extrait_chiffres & (digit.Value)
        Next digit
Set extraction = Nothing
Set reg = Nothing
.Cells(cptr, "A") = extrait_chiffres
extrait_chiffres = 0
Next
End With
End Sub

OK merci mais il y a le chiffe de groupe qui ne se supprime toujours pas ce qui fais que je me retrouve avec 1 chiffre en trop sur 3 lignes et aussi si j'ai ma plage qui se trouve de D77 a D95 que faut il modifier ?

Essayer de renvoyer un fichier représentatif

J'ai envoyé lien sur mail car il est trop gros dedans il y a aussi un form pour une progresse bar j'ai jamais réussi à la faire fonctionner si vous avez le temps

tu peux essayer ca

http://www.cjoint.com

je t'ai mis lien déjà dans ta boite mail d'ici

Je suis désolé, je ne parviens pas à l’ouvrir, ca fait une ou deux ans que je n ai pas utilise cette boite email

tu peux essayer ce lien http://www.cjoint.com

et en MP ? regarde

Bon bah j'ai trouvé un autre moyen j'ai remplacé le as long par as double c'est mieux de toute façon et donc mi cette formule dans ma première macro et tout fonctionne.

Merci a tous

Par contre pour le user form progresse bar si jamais AMIR tu veux bien m'aider vu que tu as le lien du gros fichier en mp

Range("D77:D95").Replace What:="Groupe 3", Replacement:="Groupe", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Range("D77:D95").Replace What:="Groupe 2", Replacement:="Groupe", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

    Range("D77:D95").Replace What:="Groupe 1", Replacement:="Groupe", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
Rechercher des sujets similaires à "extraction chiffre"