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

benzeboss

XLDnaute Nouveau
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€ :p (voir screenshot ci-dessous)

ScreenHunter_002.jpg

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 :D .
 

Pièces jointes

  • ScreenHunter_002.jpg
    ScreenHunter_002.jpg
    73.9 KB · Affichages: 153
  • ScreenHunter_002.jpg
    ScreenHunter_002.jpg
    73.9 KB · Affichages: 161
Dernière édition:

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:

Docmarti

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

...

@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

XLDnaute Occasionnel
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

XLDnaute Nouveau
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.

ScreenHunter_001.jpg


Merci d'avance.
 

Staple1600

XLDnaute Barbatruc
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 ;)
 
Dernière édition:

benzeboss

XLDnaute Nouveau
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 :D.
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 :D, que le vin coule à flot et que les pétards inondent votre ciel :D.

Meilleurs voeux à vous et à vos proches.
 
Dernière édition:

Statistiques des forums

Discussions
298 770
Messages
1 971 595
Membres
203 410
dernier inscrit
nicodag