XL 2013 Suppression des points de "milliers" de chiffres pour les transformer en nombre

O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Bonjour,

Je souhaiterai obtenir une Macro qui supprime les points de "de milliers" chiffres (voir IMAGE 1) pour qu'ils deviennent des nombre (voir IMAGE 3).
J'ai essayé avec le codage ci-après mais cela ne fonctionne pas, surtout avec la colonne J (voir IMAGE 2).

Sub Macro()
'
Cells.Select
Selection.Replace What:=".", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("H:H,J:J").Select
Range("J1").Activate
Selection.NumberFormat = "#,##0"
End Sub


Merci de votre aide.

Cordialement

IMAGE 1:
1633684456531.png



IMAGE 2:
1633684515816.png



IMAGE 3:
1633684544300.png
 

Pièces jointes

  • suppresion des points.xlsm
    19.9 KB · Affichages: 9
Trier par date Trier par votes
J

JHA

XLDnaute Barbatruc
Bonjour à tous,

Pourquoi ne pas sélectionner les colonnes intéressées et onglet "Accueil"/"Rechercher et sélectionner"/"Remplacer"
remplacer le point (mettre un . dans la fenêtre "rechercher") par la virgule (mettre , dans la fenêtre "remplacer par")

JHA
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
JHA à dit:
Bonjour à tous,

Pourquoi ne pas sélectionner les colonnes intéressées et onglet "Accueil"/"Rechercher et sélectionner"/"Remplacer"
remplacer le point (mettre un . dans la fenêtre "rechercher") par la virgule (mettre , dans la fenêtre "remplacer par")

JHA
Cliquez pour agrandir...
Bonjour,

Parce que c'est une macro que je souhaite intégrer dans une autre macro beaucoup plus longue et il y a cette étape ou les points de "milliers de chiffres" doivent être supprimés
Et par conséquent le résultat de cette autre macro est erronée

Cordialement.
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Je pense que je le ferais comme ça :
VB: 
Option Explicit
Sub Essai()
   Dim R As Range, T()
   Set R = ActiveSheet.[C4:P4].Resize(ActiveSheet.[C4].End(xlDown).Row - 3)
   T = R.Value
   RemplaceStrDbl T, 6
   RemplaceStrCur T, 8
   RemplaceStrCur T, 12
   R.Offset(R.Rows.Count + 1).Value = T ' Provisoire, pour vérif.
'   r.value = t ' Instruction définitive
   End Sub
Sub RemplaceStrCur(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      Select Case VarType(T(L, C))
         Case vbString: T(L, C) = CCur(Replace(T(L, C), ".", ""))
         Case vbDouble: T(L, C) = CCur(T(L, C)): End Select
      Next L
   End Sub
Sub RemplaceStrDbl(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      If VarType(T(L, C)) = vbString Then T(L, C) = CDbl(Replace(T(L, C), ".", ""))
      Next L
   End Sub
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Dranreb à dit:
Bonjour.
Je pense que je le ferais comme ça :
VB: 
Option Explicit
Sub Essai()
   Dim R As Range, T()
   Set R = ActiveSheet.[C4:P4].Resize(ActiveSheet.[C4].End(xlDown).Row - 3)
   T = R.Value
   RemplaceStrDbl T, 6
   RemplaceStrCur T, 8
   RemplaceStrCur T, 12
   R.Offset(R.Rows.Count + 1).Value = T ' Provisoire, pour vérif.
'   r.value = t ' Instruction définitive
   End Sub
Sub RemplaceStrCur(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      Select Case VarType(T(L, C))
         Case vbString: T(L, C) = CCur(Replace(T(L, C), ".", ""))
         Case vbDouble: T(L, C) = CCur(T(L, C)): End Select
      Next L
   End Sub
Sub RemplaceStrDbl(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      If VarType(T(L, C)) = vbString Then T(L, C) = CDbl(Replace(T(L, C), ".", ""))
      Next L
   End Sub
Cliquez pour agrandir...
Bonjour,

Merci beaucoup. Je regarde.

Cordialement.
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Dranreb à dit:
Bonjour.
Je pense que je le ferais comme ça :
VB: 
Option Explicit
Sub Essai()
   Dim R As Range, T()
   Set R = ActiveSheet.[C4:P4].Resize(ActiveSheet.[C4].End(xlDown).Row - 3)
   T = R.Value
   RemplaceStrDbl T, 6
   RemplaceStrCur T, 8
   RemplaceStrCur T, 12
   R.Offset(R.Rows.Count + 1).Value = T ' Provisoire, pour vérif.
'   r.value = t ' Instruction définitive
   End Sub
Sub RemplaceStrCur(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      Select Case VarType(T(L, C))
         Case vbString: T(L, C) = CCur(Replace(T(L, C), ".", ""))
         Case vbDouble: T(L, C) = CCur(T(L, C)): End Select
      Next L
   End Sub
Sub RemplaceStrDbl(T(), C As Integer)
   Dim L As Long
   For L = 1 To UBound(T, 1)
      If VarType(T(L, C)) = vbString Then T(L, C) = CDbl(Replace(T(L, C), ".", ""))
      Next L
   End Sub
Cliquez pour agrandir...
Merci

est-ce que c'est possible que la Macro ne recopie pas les données en dessous de la Base de données existante mais juste remplace la base de données existante par la nouvelle base de données sans points au niveau des chiffres ?

Merci beaucoup

1633696980082.png
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Vous n'avez pas vu qu'il y avait une instruction provisoire juste pour vous permettre de vérifier que les données seront correctement remplacées tout en gardant sous les yeux l'original ?
Dans la version définitive réaffectez simplement T à R.Value.
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Dranreb à dit:
Vous n'avez pas vu qu'il y avait une instruction provisoire juste pour vous permettre de vérifier que les données seront correctement remplacées tout en gardant sous les yeux l'original ?
Dans la version définitive réaffectez simplement T à R.Value.
Cliquez pour agrandir...
Bonjour,

Lorsque j'essaie sur un fichier qui fait 15 200 lignes de longueur votre Macro ne fonctionne pas.
Savez vous résoudre ce problème ?

Merci d'avance
Cordialement
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Dranreb à dit:
Peut être y a t-il une cellule vide en colonne C avant la fin des données ?
Si vous initialisez convenablement le Range R ça doit marcher sans problème.
Cliquez pour agrandir...
bonjour,

J'ai ce message d'erreur qui apparait lorsque le fichier fait 15 200 lignes
J'ai joint le fichier : https://www.cjoint.com/c/KJpoci77cCe

est-ce que vous pouvez regarder ?

Merci d'avance.
Cordialement
1634306260184.png
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Je propose une autre écriture qui permettrait de trouver plus vite ce genre de cas :
VB: 
Option Explicit
Sub Essai()
   Dim R As Range, T()
   Set R = ActiveSheet.[C4:P4].Resize(ActiveSheet.[C4].End(xlDown).Row - 3)
   RemplaceStrDbl R.Columns(6)
   RemplaceStrCur R.Columns(8)
   RemplaceStrCur R.Columns(12)
   End Sub
Sub RemplaceStrCur(ByVal R As Range)
   Dim T(), L As Long
   On Error Resume Next
   T = R.Value
   For L = 1 To UBound(T, 1)
      Err.Clear
      Select Case VarType(T(L, 1))
         Case vbString: T(L, 1) = CCur(Replace(T(L, 1), ".", ""))
            If Err Then
               Application.Goto R.Cells(L, 1)
               If MsgBox("""" & T(L, 1) & """ non convertible en Currency." _
                  & vbLf & Err.Description & vbLf & "Voulez-vous continuer ?", _
                  vbExclamation + vbYesNo, "RemplacerStrCur") = vbNo Then End
               End If
         Case vbDouble: T(L, 1) = CCur(T(L, 1)): End Select
      Next L
   R.Value = T
   End Sub
Sub RemplaceStrDbl(ByVal R As Range)
   Dim T(), L As Long
   On Error Resume Next
   T = R.Value
   For L = 1 To UBound(T, 1)
      Err.Clear
      Select Case VarType(T(L, 1))
         Case vbString: T(L, 1) = CDbl(Replace(T(L, 1), ".", ""))
            If Err Then
               Application.Goto R.Cells(L, 1)
               If MsgBox("""" & T(L, 1) & """ non convertible en Double." _
                  & vbLf & Err.Description & vbLf & "Voulez-vous continuer ?", _
                  vbExclamation + vbYesNo, "RemplacerStrDbl") = vbNo Then End
               End If
         Case vbCurrency: T(L, 1) = CDbl(T(L, 1)): End Select
      Next L
   R.Value = T
   End Sub
 
Vote positif 0 Vote négatif
O

onyirimba

XLDnaute Occasionnel
Supporter XLD
Dranreb à dit:
Je propose une autre écriture qui permettrait de trouver plus vite ce genre de cas :
VB: 
Option Explicit
Sub Essai()
   Dim R As Range, T()
   Set R = ActiveSheet.[C4:P4].Resize(ActiveSheet.[C4].End(xlDown).Row - 3)
   RemplaceStrDbl R.Columns(6)
   RemplaceStrCur R.Columns(8)
   RemplaceStrCur R.Columns(12)
   End Sub
Sub RemplaceStrCur(ByVal R As Range)
   Dim T(), L As Long
   On Error Resume Next
   T = R.Value
   For L = 1 To UBound(T, 1)
      Err.Clear
      Select Case VarType(T(L, 1))
         Case vbString: T(L, 1) = CCur(Replace(T(L, 1), ".", ""))
            If Err Then
               Application.Goto R.Cells(L, 1)
               If MsgBox("""" & T(L, 1) & """ non convertible en Currency." _
                  & vbLf & Err.Description & vbLf & "Voulez-vous continuer ?", _
                  vbExclamation + vbYesNo, "RemplacerStrCur") = vbNo Then End
               End If
         Case vbDouble: T(L, 1) = CCur(T(L, 1)): End Select
      Next L
   R.Value = T
   End Sub
Sub RemplaceStrDbl(ByVal R As Range)
   Dim T(), L As Long
   On Error Resume Next
   T = R.Value
   For L = 1 To UBound(T, 1)
      Err.Clear
      Select Case VarType(T(L, 1))
         Case vbString: T(L, 1) = CDbl(Replace(T(L, 1), ".", ""))
            If Err Then
               Application.Goto R.Cells(L, 1)
               If MsgBox("""" & T(L, 1) & """ non convertible en Double." _
                  & vbLf & Err.Description & vbLf & "Voulez-vous continuer ?", _
                  vbExclamation + vbYesNo, "RemplacerStrDbl") = vbNo Then End
               End If
         Case vbCurrency: T(L, 1) = CDbl(T(L, 1)): End Select
      Next L
   R.Value = T
   End Sub
Cliquez pour agrandir...
Je vous remercie
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Inversion jour / mois
Réponses
2
Affichages
371
dysorthographie
dysorthographie
B
  • Question
Microsoft 365 Remplacer "." par "," avec VBA sans qu'il considère que c'est des milliers si ça ne commence par "0."
Réponses
1
Affichages
548
Eric KERGRESSE
E
D
  • Question
Microsoft 365 Problème avec remplacer . par ,
Réponses
3
Affichages
401
de_hanstrapp
D
N
  • Résolu(e)
XL 2019 transformation de cordonnée GPS
Réponses
14
Affichages
999
sylvanu
sylvanu
M
  • Question
XL 2016 Problème avec fonction VBA
Réponses
7
Affichages
584
MCOTTEND
M
K
  • Résolu(e)
XL 2016 Ne garder que les chiffres dans la colonne A et remplacer les h et '
2
Réponses
16
Affichages
2 K
Phil69970
Phil69970
albuqs
  • Résolu(e)
XL 2016 Selection.replace inopérante
Réponses
4
Affichages
501
albuqs
albuqs
E
  • Résolu(e)
XL 2019 Format Date Anglais / Francais
Réponses
5
Affichages
2 K
EDI9366
E
A
  • Question
XL 2016 Remplacer des valeurs dans toutes une feuilles VBA
Réponses
8
Affichages
708
Robert
Robert
A
  • Résolu(e)
Microsoft 365 remplacement . ou , par séparateur de décimal en VBA
2
Réponses
25
Affichages
6 K
onyirimba
O

Membres actuellement en ligne

5 membres et 93 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 096
Messages
2 116 184
Membres
112 678
dernier inscrit
arno12345678