[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: 160
  • ScreenHunter_002.jpg
    ScreenHunter_002.jpg
    73.9 KB · Affichages: 167
Dernière édition:

benzeboss

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

Merci pour ton aide.

Voici le fichier.

Bonne réception. :p
 

Pièces jointes

  • essai macro excel.xlsm
    189.4 KB · Affichages: 90
  • essai macro excel.xlsm
    189.4 KB · Affichages: 108
  • essai macro excel.xlsm
    189.4 KB · Affichages: 80

benzeboss

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

Bonjour à tous,
ce n'est pas "juste" un histoire de format international?

Bon courage

Oui, je cherche à enlever les points et les remplacer par rien avec un code VBA, le code fonctionne car il m'enlève bien les points, mais en faisant la somme, ben j'obtiens "232" alors que le résultat que je dois avoir se chiffre en M€.
J'ai joint un screen en post1.
 

sousou

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

bonjour
Vite fait: Remplace aussi les espace qui viennent de ton extraction, et fait tournée suite sur la sélection que tu souhaites voir être modifée en nombre
Les calculs devraient être meilleurs
Sub Macro3()
'
' Macro3 Macro
'

'
Columns("B:B").Select

Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub
Sub suite()
For Each i In Selection
i.Value = CDbl(i)
Next
End Sub
 

benzeboss

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

bonjour
Vite fait: Remplace aussi les espace qui viennent de ton extraction, et fait tournée suite sur la sélection que tu souhaites voir être modifée en nombre
Les calculs devraient être meilleurs
Sub Macro3()
'
' Macro3 Macro
'

'
Columns("B:B").Select

Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub
Sub suite()
For Each i In Selection
i.Value = CDbl(i)
Next
End Sub

Bonjour,

Merci pour votre réponse, les résultats sont déjà plus encourageant. Cependant, j'ai encore un écart de 3 M€ :/

Voici l'ensemble du code, j'ai également joint à nouveau le fichier.

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

End Sub

Sub Macro3()
'
' Macro3 Macro
'

'
Range("B2:B999").Select

Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

End Sub
Sub suite()
For Each i In Selection
i.Value = CDbl(i)
Next
End Sub


Merci d'avance.
 

Pièces jointes

  • essai macro excel.xlsm
    188.4 KB · Affichages: 71
  • essai macro excel.xlsm
    188.4 KB · Affichages: 85
  • essai macro excel.xlsm
    188.4 KB · Affichages: 91

Staple1600

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

Bonjour à tous

Une autre voie possible (sans macros)
En passant par Données/Convertir
et à l'étape 3 cliquer sur Avancé -> Séparateur de décimale: choisir le point

Normalement ta colonne contiendra alors des données numériques

Voir copie écran ci-dessous
DONNCONV.jpg
 

Docmarti

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

Bonjour à benzeboss et à tous.


Voici la solution à ton problème.

C'est une question de symbole décimal régional.
Contrairement à la propriété TEXT des cellules qui affiche les nombres avec le symbole décimal régional,
la propriété VALUE des cellules exige le point comme symbole décimal, sinon la valeur est considérée comme du texte, donc non numérique.

Il faut donc que tu remplaces ton symbole décimal régional par un point ( qui est le symbole régional américain ).

En voici la démonstration:

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

  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
    Columns("B:B").NumberFormat = "General"

    If Format(0, ",") <> "." Then
    
    Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
     Selection.Replace What:=Format(0, ","), Replacement:=".", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
   End If
    
End Sub


Cordialement

Docmarti
 
Dernière édition:

Staple1600

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

Bonsoir à tous

Docmarti:
Et la solution avec Données/Convertir que j'évoquais plus bas, fonctionne aussi, non ?
L'avantage étant que c'est une fonctionnalité native Exel donc reproductible dans n'importe classeur sans devoir avoir un code VBA sous la main à copier dans N classeurs à traiter.
 

Docmarti

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

Bonsoir à tous

Docmarti:
Et la solution avec Données/Convertir que j'évoquais plus bas, fonctionne aussi, non ?
L'avantage étant que c'est une fonctionnalité native Exel donc reproductible dans n'importe classeur sans devoir avoir un code VBA sous la main à copier dans N classeurs à traiter.

Bonjour Staple1600.
Je ne me permettrai pas d'évaluer ta solution avec Données/Convertir, mes connaissances se limitant uniquement au VBA qui répond entièrement à mes intérêts et à mes besoins.
Mais j'ai pu constater que les fonctions natives d'Excel sont en effet très performantes et je ne doute pas que ta solution fonctionne.

Cordialement

Docmarti
 

benzeboss

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

Bonjour,

Merci pour vos réponses.

@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

@Staple1600 : La solution Donnée/convertir marche aussi, tout comme le Ctrl+F en remplacement les points, cependant, je souhaiterais l'automatiser, je veux juste cliquer sur un bouton, le temps de me chercher un café, et pouvoir commencer à travailler (car je kiffe mon boulot :p)


Dans tous les cas, j'apprécie votre aide à tous :)
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 899
Membres
101 834
dernier inscrit
Jeremy06510