XL 2019 Supprimer uniquement les chiffres dans les cellules d'une colonne

[eduraiss]

Bonjour le forum

Ci-joint un fichier
En colonne A des cellules avec des noms a l'intérieur certains ont des chiffres et d'autres pas

Il me faudrait si possible une automatisation VBA pour supprimer les chiffres uniquement

Merci de votre aide

Cordialement,

 

[djidji59430]

Bonjour à tous,

C'est toujours 1 seul chiffre ?

Crdlmt

 

[eduraiss]

Bonjour djidji 59430

Soit trois possibilités
1 ou 2 ou rien

 

[soan]

Bonjour Eric, djidji,

ton fichier en retour ; fais Ctrl e ➯ travail effectué. 😊

Option Explicit

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T, chn$, lng As Byte, p As Byte, c As Byte, i&
  n = n - 1: T = [A2].Resize(n)
  For i = 1 To n
    chn = T(i, 1): lng = Len(chn)
    If lng > 0 Then
      p = lng
      Do
        c = Asc(Mid$(chn, p, 1))
        If c = 32 Or (c >= 48 And c <= 57) Then p = p - 1 Else Exit Do
      Loop Until p < 2
      T(i, 1) = Left$(chn, p)
    End If
  Next i
  Application.ScreenUpdating = 0: [A2].Resize(n) = T
End Sub

soan

 

[eduraiss]

Re
Bonjour soan
Merci beaucoup cela fonctionne nickel

Cordialement,

 

[Staple1600]

Bonsoir le fil, eduraiss, djidji, soan

Une autre syntaxe VBA possible

Sub Pas_de_chiffres()
Dim cr&, c&, colA
With Application
    .ScreenUpdating = False
    colA = Range("A1", Cells(.Rows.Count, "A").End(xlUp)).Value2
    For c = 1 To UBound(colA)
        For cr = 1 To Len(colA(c, 1))
        If Mid(colA(c, 1), cr, 1) Like "[0-9]" Then Mid(colA(c, 1), cr) = Chr(1)
        Next
        colA(c, 1) = .Trim(Replace(colA(c, 1), Chr(1), vbNullString))
    Next
End With
Cells(2).Resize(UBound(colA)) = colA
End Sub

Et une autre pour le fun

Dim X&
Sub Pour_le_Fun(Optional CodeVBA_post_CouvreFeu)
X = Cells(Rows.Count, 1).End(3).Row
Cells(2)(2).Resize(X).Formula = "=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A2,0,""""),1,""""),2,""""),3,""""),4,""""),5,""""),6,""""),7,""""),8,""""),9,"""")"
Cells(2)(2).Resize(X) = Cells(2)(2).Resize(X).Value
End Sub

NB: On peut aussi le faire avec la formule qu'on peut voir dans la seconde macro

 

[mapomme]

Bonsoir à tous,

Une autre :

Sub SansChiffre()
Dim i&
   Application.ScreenUpdating = False
   With Intersect(Sheets("Feuil1").Columns(1), Sheets("Feuil1").UsedRange)
      For i = 0 To 9: .Replace What:=i, Replacement:="", LookAt:=xlPart: Next i
   End With
End Sub

 

[Staple1600]

Bonsoir mapomme 😉

Reste plus que la version avec RegExp

 

[Staple1600]

Re

La voici
(heureusement que mon armoire à RegExp est à portée de main 😉)

Sub version_RegExp()
Dim colA, c&
colA = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value2
With CreateObject("VBScript.RegExp")
    .Pattern = "\d"
    For c = 1 To UBound(colA)
    colA(c, 1) = .Replace(colA(c, 1), vbNullString)
    Next
End With
Range("A1", Cells(Rows.Count, "A").End(xlUp)) = colA
End Sub

NB: Ne fonctionne pas sur Excel Mac