Supprimer lettres et laisser chiffres

[pedro_23]

Bonjour,

Dans la même colonne, j'ai des lettres et des chiffres!

Avez vous une petite astuce (formule ou code VBA) qui permet de effacer toutes les lettres des celulles selectionnées et laisse uniquement les chiffres?

D'avance, je vous remercie

 

[jp14]

Re : Supprimer lettres et laisser chiffres

Bonjour et bienvenue sur le forum

Un exemple de macro qui élimine dans une cellule tous les caractères sauf les symboles numériques.

Sub essai()
Dim val1 As String
Dim i As Long
For i = 1 To Len(ActiveCell)
    If Asc(Mid(ActiveCell, i, 1)) > 47 And Asc(Mid(ActiveCell, i, 1)) < 59 Then val1 = val1 & Mid(ActiveCell, i, 1)
Next
ActiveCell = val1
End Sub

JP

 

[CBernardT]

Re : Supprimer lettres et laisser chiffres

Bonsoir pedro_23,

Bienvenue sur le forum

Salut jp14

Une solution par fonction VBA.

Dans les cellules, il suffit d'y placer la formule : =SelecChiffres($A3)

La liste des chiffres présents dans le texte seront listés et affichés dans la cellule.

 

[phlaurent55]

Re : Supprimer lettres et laisser chiffres

Bonjour à tous,

@ Bernard,
ta solution donne la réponse attendue mais pour avoir le résultat au format nombre il est nécessaire d'ajouter: =SelecChiffres($A3) *1

bonne fin de journée
à+
Philippe
.

 

[pedro_23]

Re : Supprimer lettres et laisser chiffres

Bonjour,

Merci pour la réponse mais lors que je lance la macro , seules les lettre d'une cellule sont effacés!

je voudrait pouvoir le faire pour une colonne complete
Merci

 

[pedro_23]

Re : Supprimer lettres et laisser chiffres

Bonsoir à tous,

JP14, la macro fonctionne mais uniquement pour une celulle à la fois! je voudrait faire sur une colonne entiere!

Merci

 

[CBernardT]

Re : Supprimer lettres et laisser chiffres

Re,

Bien vu pour le format nombre.

Modification effectuée dans la fonction :

Function SelecChiffres(X As Range)
Dim i As Integer, Chiffres As String
For i = 1 To Len(X)
If IsNumeric(Mid(X, i, 1)) Then
Chiffres = Chiffres & Mid(X, i, 1)
End If
Next i
SelecChiffres = Chiffres * 1
End Function

L'incrémentation de la formule est également possible.

 

[jp14]

Re : Supprimer lettres et laisser chiffres

Bonjour le fil

Ci dessous une macro pour convertir une colonne.
On peut sélectionner une colonne ou une zone.

Sub essai()
Dim val1 As String
Dim i As Long
Dim cell As Range
Dim oldCalculation As Variant '
Dim reponse As Variant

oldCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
On Error GoTo suite
Set reponse = Application.InputBox(Prompt:="Veuillez sélectionner la zone à convertir", Type:=8, Default:="")

Application.ScreenUpdating = False 'gele l'ecran
Application.EnableEvents = False
Application.DisplayAlerts = False 'interdit les messages d'avertissements

For Each cell In reponse
    If cell = "" Then
    Else
        val1 = ""
        For i = 1 To Len(cell)
            If Asc(Mid(cell, i, 1)) > 47 And Asc(Mid(cell, i, 1)) < 59 Then val1 = val1 & Mid(cell, i, 1)
        Next
        cell = val1
    End If
Next cell
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = oldCalculation
'Application.DisplayAlerts = True ' par défaut
Exit Sub
suite:
Resume fin
End Sub

A tester

JP

 

[JANO]

Re : Supprimer lettres et laisser chiffres

Bonjour le forum,

pouriez vous m'aider à modifier la macro ci dessous, elle efface les lettres mais jaimerai une condition ;
efface toutes les lettres sauf les mots "titre" et "mat".

merci de votre aide

Sub essai()
Dim val1 As String
Dim i As Long
Dim cell As Range
Dim oldCalculation As Variant '
Dim reponse As Variant

oldCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
On Error GoTo suite
Set reponse = Application.InputBox(Prompt:="Veuillez sélectionner la zone à convertir", Type:=8, Default:="")

Application.ScreenUpdating = False 'gele l'ecran
Application.EnableEvents = False
Application.DisplayAlerts = False 'interdit les messages d'avertissements

For Each cell In reponse
If cell = "" Then
Else
val1 = ""
For i = 1 To Len(cell)
If Asc(Mid(cell, i, 1)) > 47 And Asc(Mid(cell, i, 1)) < 59 Then val1 = val1 & Mid(cell, i, 1)
Next
cell = val1
End If
Next cell
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = oldCalculation
'Application.DisplayAlerts = True ' par défaut
Exit Sub
suite:
Resume fin
End Sub