Microsoft 365 Recherche de certains caractères dans cellule

  • Initiateur de la discussion Initiateur de la discussion netparty
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

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

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

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
 
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

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
395
Retour