Microsoft 365 Boucle VB pour supprimer les caractères spéciaux et numériques d'une chaîne

chris6999

XLDnaute Impliqué
Bonjour le forum

Je souhaiterais savoir comment récupérer les caractères alpha en excluant les caractères spéciaux et numériques en utilisant une boucle det ype for each...
J'ai trouvé des fonctions intéressantes mais je ne parviens pas à les inclure dans ma boucle.( Oui je sais je suis pas experte en VBA !)

Je passe sur la colonne E et je récupère dans E tous les caractères ALPHA de la cellule même ligne colonne D

Je ne mets pas de fichier en PJ car je n'en vois pas la plus value dans ce cas particulier

Merci par avance pour votre aide
Bonne journée à tous

Sub test()
Derlig = Range("B" & Rows.Count).End(xlUp).Row

'supprime les espaces
For Each c In Range(Cells(4, "E"), Cells(Derlig, "E"))
c.Value = CharAllowed(c.Offset(0 - 1))
Next
End Sub




Public Function CharAllowed(ByVal s As String) As String
' 2020-02-20 MN Création

Dim s1 As String, i As Integer, s2 As String

If Len(s) > 0 Then
s = ChaineSansAccent(s)

s1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
s2 = ""
For i = 1 To Len(s)
If InStr(1, s1, CStr(Mid(s, i, 1)), 0) = 0 Then
Debug.Print "Le caractère '" & Mid$(s, i, 1) & "' n'est pas autorisé"
Else
s2 = s2 + Mid(s, i, 1)
End If
Next i
CharAllowed = s2
End If

End Function
Private Function ChaineSansAccent(ByVal s As String) As String
' 2020-02-20 MN
Dim s1 As String, s2 As String, i As Long

s1 = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜ"
s2 = "AAAAAAEEEEIIIIOOOOOUUUU"
For i = 1 To Len(s1)
s = Replace(s, Mid$(s1, i, 1), Mid$(s2, i, 1))
Next i
ChaineSansAccent = s
End Function
 

wDog66

XLDnaute Occasionnel
Bonjour chris6999

Pas besoin de mettre une sub puisque vous avez une fonction PUBLIC
En E2, vous mettez simplement
VB:
=CharAllowed(D2)

Dans votre fonction il manque juste
Code:
Public Function CharAllowed(ByVal s As String) As String
Application.Volatile
' Suite du code

A+
 

patricktoulon

XLDnaute Barbatruc
bonjour
le tout en une
VB:
Public Function CharAllowed(ByVal s As String) As String
    Dim s1$, i&, s2$, T$
    s1 = "ÀÁÂÃÄÅÈÉÊËÌÍÎÏÒÓÔÕÖÙÚÛÜ"
    s2 = "AAAAAAEEEEIIIIOOOOOUUUU"
    'replace des accents
    For i = 1 To Len(s)
        s = Replace(s, Mid$(s1, i, 1), Mid$(s2, i, 1))
    Next i
    'on garde que les lettre (majuscule ou minuscule)
    For i = 1 To Len(s)
        If UCase(Mid(s, i, 1)) Like "[A-Z]" Then T = T & Mid(s, i, 1)
    Next
    CharAllowed = T
End Function



Sub test()
    MsgBox CharAllowed("ÂÃÄÅÈÉ54236;:dfg,/+ahsotBTY456")
End Sub
'exemple formule : =CharAllowed(A1)
 

Discussions similaires

Réponses
7
Affichages
426

Statistiques des forums

Discussions
313 323
Messages
2 097 153
Membres
106 854
dernier inscrit
Alex_Touge