Microsoft 365 Recherche de certains caractères dans cellule

netparty

XLDnaute Occasionnel
Bonjour à tous

Je suis à la recherche d’une macro pour vérifier si il y a des caractères interdits dans une plage de cellule.
Les caractères à vérifier sont les suivant \ / : * ? " < >
La sélection des cellule se fait soit directement par sélection dans la feuille ou via les textbox du formulaire textbox1 pour la cellule de départ et textbox2 pour la cellule de fin.

Le 1er bouton sert à vérifier l’existence des caractères \ / : * ? " < > présent dans les cellules si il y a ces caractères alors la cellule est mise en rouge.
A l’aide d’un 2ième bouton, j’aimerai que les caractères <> soient supprimé.

Merci d'avance
 

Pièces jointes

  • Caractères interdit.xlsm
    18.9 KB · Affichages: 12

job75

XLDnaute Barbatruc
Bonjour netparty,

Utiliser un UserForm c'est bien lourd, il vaut mieux une InputBox.

Voyez le fichier joint et les macros des boutons :
VB:
Sub Detecter()
Dim r As Range, interdit$, d As Object, i%, x$
Application.DisplayAlerts = False
On Error Resume Next
Set r = Application.InputBox("Sélectionnez une plage :", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone 'RAZ
Set r = Intersect(r, ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
interdit = "\/:*?""<>"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To Len(interdit)
    d(Mid(interdit, i, 1)) = ""
Next
For Each r In r
    x = r
    For i = 1 To Len(x)
        If d.exists(Mid(x, i, 1)) Then r.Interior.ColorIndex = 3: Exit For
Next i, r
End Sub

Sub Supprimer()
Dim r As Range, interdit$, d As Object, i%, x$
Application.DisplayAlerts = False
On Error Resume Next
Set r = Application.InputBox("Sélectionnez une plage :", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set r = Intersect(r, ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
r.Interior.ColorIndex = xlNone 'RAZ
interdit = "\/:*?""<>"
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To Len(interdit)
    d(Mid(interdit, i, 1)) = ""
Next
For Each r In r
    x = r
    For i = Len(x) To 1 Step -1
        If d.exists(Mid(x, i, 1)) Then x = Left(x, i - 1) & Mid(x, i + 1)
    Next i
    r = x
Next r
End Sub
A+
 

Pièces jointes

  • Caractères interdits(1).xlsm
    20.6 KB · Affichages: 9

netparty

XLDnaute Occasionnel
Bonjour job75 , sylvanu

Merci à vous 2 deux pour votre code, après la correction et le suppression des caractères interdit est-possible de supprimer les espaces ou se trouvais ces caractères ?

@ sylvanu après la correction est-il possible de remettre la cellule dans sa couleur d'origine

Merci
 

job75

XLDnaute Barbatruc
après la correction et le suppression des caractères interdit est-possible de supprimer les espaces ou se trouvais ces caractères ?
Pour supprimer les espaces encadrant un caractère interdit voyez ce fichier (2) :
VB:
For Each r In r
    x = r
    For i = Len(x) To 1 Step -1
        If d.exists(Mid(x, i, 1)) Then x = Trim(Left(x, i - 1)) & Trim(Mid(x, i + 1))
    Next i
    r = x
Next r
 

Pièces jointes

  • Caractères interdits(2).xlsm
    20.8 KB · Affichages: 2

Discussions similaires

Réponses
12
Affichages
483