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

onyirimba · 8 Octobre 2021

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:

IMAGE 2:

IMAGE 3:

JHA · 8 Octobre 2021

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

onyirimba · 8 Octobre 2021

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

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.

Dranreb · 8 Octobre 2021

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

onyirimba · 8 Octobre 2021

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

Bonjour,

Merci beaucoup. Je regarde.

Cordialement.

onyirimba · 8 Octobre 2021

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

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

Dranreb · 8 Octobre 2021

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.

onyirimba · 14 Octobre 2021

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.

je vous remercie

onyirimba · 14 Octobre 2021

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.

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

Dranreb · 14 Octobre 2021

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.

onyirimba · 15 Octobre 2021

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.

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

Dranreb · 15 Octobre 2021

C'est à cause de la cellule 'Part & Spar'!H2984 qui contient "V" au lieu de de chiffres avec ou sans point.

onyirimba · 15 Octobre 2021

Dranreb à dit:
C'est à cause de la cellule 'Part & Spar'!H2984 qui contient "V" au lieu de de chiffres avec ou sans point.

Je vous remercie

Dranreb · 15 Octobre 2021

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

onyirimba · 15 Octobre 2021

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

Je vous remercie

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

onyirimba

XLDnaute Occasionnel

Pièces jointes

JHA

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

onyirimba

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

onyirimba

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

Dranreb

XLDnaute Barbatruc

onyirimba

XLDnaute Occasionnel

Discussions similaires