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

B

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: 161
  • ScreenHunter_002.jpg
    ScreenHunter_002.jpg
    73.9 KB · Affichages: 168
Dernière édition:
Trier par date Trier par votes
Staple1600

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:
Vote positif 0 Vote négatif
D

Docmarti

XLDnaute Occasionnel
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
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
D

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
 
Vote positif 0 Vote négatif
B

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.
 
Vote positif 0 Vote négatif
Staple1600

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:
Vote positif 0 Vote négatif
B

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:
Vote positif 0 Vote négatif

Discussions similaires

Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
Nicolas JACQUIN
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
410
vgendron
vgendron
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
2 K
TooFatBoy
TooFatBoy
Etoto
  • Résolu(e)
Microsoft 365 VBA Insertion du numéro de semaine de manière dynamique
Réponses
11
Affichages
221
Etoto
Etoto
L
  • Question
Microsoft 365 Changement de couleurs de cellules dans plusieurs feuilles suite à une modification
Réponses
4
Affichages
612
lolo_excelbeginner
L
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
792
Kevin38
K
A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
138
patricktoulon
patricktoulon
C
  • Question
XL 2021 Problème de remplissage d'une colonne conditionné à d'autres valeurs
Réponses
2
Affichages
373
CathyLD
C
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
351
marie3107
M
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
553
marie3107
M

Membres actuellement en ligne

4 membres et 41 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 534
Membres
112 771
dernier inscrit
mikadu49