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

[chris6999]

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]

Bonjour chris6999

Pas besoin de mettre une sub puisque vous avez une fonction PUBLIC
En E2, vous mettez simplement

=CharAllowed(D2)

Dans votre fonction il manque juste

Public Function CharAllowed(ByVal s As String) As String
Application.Volatile
' Suite du code

A+

 

[chris6999]

Merci pour votre réponse mais je ne traite pas que la ligne 2. je souhaite faire une boucle.
A moins que je n'ai pas compris votre proposition ce qui est tout à fait possible

 

[wDog66]

Re,

A moins que je n'ai pas compris votre proposition ce qui est tout à fait possible

Tout à fait, vous recopiez vers le bas la formule mise en E2

 

[chris6999]

Je m'en doutais un peu ...ma nullité reste néanmoins au niveau de ma crédulité!
Ça fonctionne très bien merci encore

 

[patricktoulon]

bonjour
le tout en une

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)