[RESOLU] [VBA] Problème pour remplacer les points par rien

benzeboss · 23 Décembre 2013

Bonjour à tous,

Je suis actuellement entrain d'essayer de générer un code pour mettre en forme des données que j'importe d'un logiciel sur SAP.
Je rencontre depuis vendredi après-midi un problème à la fois curieux et bizarre, il remplace bien les points par rien avec mon code :

Code:

    Columns("B:B").Select
    Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Mais, quand je veux faire la somme de ma colonne B, j'obtiens un résultat de "232" alors que le vrai résultat est en M€ 😛 (voir screenshot ci-dessous)

Je vous joint également le code en entier, quand tous fonctionnera, je ferais l'épuration de celui-ci.

Code:

Sub essai1()
Dim i As Integer
Dim X As Long
Dim R As Range

    Rows("1:36").Select
    Range("A36").Activate
    Selection.Delete Shift:=xlUp
    Range("A:A,C:E,G:U").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Range("A1:B999").Select
    For n = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -1
  If Range("A" & n) = "* Sur-/Sous-absorption" Then
    Rows(n).Delete
  End If
  Next
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.SmallScroll Down:=-12
    Range("A1:B1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092492
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select

  For Each R In Range("A1", [A6000].End(xlUp))
    R = Replace(LTrim(R), Chr(160), "")
  Next

For X = 2 To Range("B65536").End(xlUp).Row
        Range("B" & X) = Replace(Range("B" & X), Chr(160), "")
        Range("B" & X) = Replace(Range("B" & X), Chr(32), "")
Next X

    Columns("B:B").Select
    Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub

Merci d'avance pour votre aide.

Bonne fête 😀 .

Staple1600 · 30 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour à tous

benzeboss
Il suffit de faire un Données/Convertir et d'enregistrer une macro en laissant tourner l'enregistreur 😉
Et ensuite d'affecter cette macro à ton bouton
(sauf que théoriquement la macro aura fini son job si rapidement que tu n'auras même pas le temps d'aller chercher ton café 😉

Exemple ci-dessous OK ici (avec Excel 2003, colonne traitée : A )

Code:

Sub DONCONVOK()
'Equivalent Macro de Données/Convertir
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, DecimalSeparator:=".", TrailingMinusNumbers:=True
End Sub

Docmarti · 30 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

benzeboss à dit:
...

@Docmardi : En essayant vos solutions, j'obtiens le même résultat, mais j'ai encore une différence (voir screen ci-dessous)

Ce lien n'existe plus

Le lien n'est pas valide. Donc, sans davantage de précisions, je ne peux voir où réside le problème.

Quel est le résultat exact attendu ?

Docmarti

Docmarti · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour benzeboss; JM; tous

Voici une routine qui corrige et remplace les valeurs numériques de type TEXTE par une valeur de type DOUBLE.

Testée avec différents paramètres linguistiques régionaux.

Cordialement

Docmarti

VB:

Sub essai1()
        
    Dim i As Integer
    Dim x As Long
    Dim R As Range
    
    Rows("1:36").Select
    Range("A36").Activate
    Selection.Delete Shift:=xlUp
    Range("A:A,C:E,G:U").Select
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    Columns("A:A").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Range("A1:B999").Select
    For n = Range("A" & Rows.Count).End(xlUp).Row To 5 Step -1
        If Range("A" & n) = "* Sur-/Sous-absorption" Then
            Rows(n).Delete
        End If
    Next
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    ActiveWindow.SmallScroll Down:=-12
    Range("A1:B1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092492
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    
    Call StringToNumeric
     
End Sub

Sub StringToNumeric()
    'Par Gerard Boulanger - Docmarti
    Dim x
    
    Dim separateurDeMillierASupprimer As String
    
    'L'utilisateur doit indiquer quel est le séparateur de milliers à effacer, si on en trouve parmi les nombres
    'Ne pas mettre ici le séparateur décimal utilisé dans les valeurs String des cellules, car il serait supprimé.
    separateurDeMillierASupprimer = "."
    
    Set sel = Columns("B:B")
    
    sel.NumberFormat = "General"
    
    'Il faut enlever tous les caractères non numériques
    sel.Replace What:=Chr(160), Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    sel.Replace What:=Chr(32), Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
    'Remplacer les valeurs String par leur équivalent numérique
    For x = 2 To Range("B65536").End(xlUp).Row
        If Trim(Range("B" & x).Value) <> "" Then
            
            'On ne doit pas modifier les cellules qui sont déjà de types numerique ou date
            If TypeName(Range("B" & x).Value) = "String" Then
                
                'Supprimer le separateur de milliers présents dans les cellules
                Range("B" & x).Value = Replace(Range("B" & x).Value, separateurDeMillierASupprimer, "")
                
                'Remplacer la valeur String par leur valeur numerique avec le séparateur décimal requis par le système
                If IsNumeric(Replace(Range("B" & x).Value, ",", Format(0, "."))) Then
                    'Format(0, ".") donne le séparateur décimal selon le Panneau de configuration de Windows
                    Range("B" & x).Value = CDbl(Replace(Range("B" & x).Value, ",", Format(0, ".")))
                End If
                
            End If
        End If
    Next
    
End Sub

benzeboss · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour,

@Staple1600 : J'ai essayé votre solution, quand je fais la somme j'obtiens le résultat de "232" 🙁

@Docmardi : Merci pour votre code, je l'ai essayé, j'ai toujours la même différence que mon post précédent, mais cette fois-ci, je vous joint un lien valide.

Merci d'avance.

Staple1600 · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour à tous

benzeboss
Données/Convertir transforme bien les données en données numériques
J'ai testé sur la colonne F de ta pièce jointe.
Maintenant reste à savoir quelles cellules en particulier tu veux sommer ?

EDITION: Bonjour Pierrejean 😉

pierrejean · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour à tous

Voyez votre fichier après exécution des macros test et test1

benzeboss · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour PierreJean,

J'ai exécuté les macros "test" et "test1" comme vous l'avez écrit dans votre post, mais en faisant la somme, j'ai toujours les 3M€ de différence :/.

benzeboss · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Bonjour à tous,

J'ai une bonne nouvelle, ça marche. J'ai trouvé la raison du problème (pas taper ^^), en faites, la différence vient pas d'un problème de format, mais de l'export, en faites, j'ai réexporter la liste et puis je suis tombé sur la bonne somme 😀.
Ce sujet régorge de solution pour lutter contre le problème de remplacer les points par rien ^^.

Je vous souhaites à tous et toutes un bon réveillon 😀, que le vin coule à flot et que les pétards inondent votre ciel 😀.

Meilleurs voeux à vous et à vos proches.

pierrejean · 31 Décembre 2013

Re : [VBA] Problème pour remplacer les points par rien

Re

La différence est bien exposée dans le fichier que j'ai fourni (voir en début de colonne M)

benzeboss · 2 Janvier 2014

Re : [VBA] Problème pour remplacer les points par rien

pierrejean à dit:
Re

La différence est bien exposée dans le fichier que j'ai fourni (voir en début de colonne M)

Oui, je l'ai pas de suite vu, mais quand je l'ai vu, j'ai de suite réexporter mon fichier et là ça collé 😀 .

En tout cas, merci pour votre aide.

Happy New Year !! 😛

Effectuez une recherche sur Excel Downloads...

[RESOLU] [VBA] Problème pour remplacer les points par rien

benzeboss

XLDnaute Nouveau

Pièces jointes

Staple1600

XLDnaute Barbatruc

Docmarti

XLDnaute Occasionnel

Docmarti

XLDnaute Occasionnel

benzeboss

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

benzeboss

XLDnaute Nouveau

benzeboss

XLDnaute Nouveau

pierrejean

XLDnaute Barbatruc

benzeboss

XLDnaute Nouveau

Discussions similaires

Nous accordons de l'importance à votre vie privée