XL 2019 [RESOLU] Definir expression régulière

darkjedi · 17 Février 2021

Bonjour à tous,

Suite à une recherche infructueuse sur le forum soit d'exemples ou d'explications pour résoudre mon problème, j'ouvre un nouveau fil pour que vous puissiez m'aider sur ce sujet.

J’aimerais définir une expression régulière dans une macro afin que si la saisie de l'utilisateur dans une cellule de la colonne A n'est pas correcte, alors une boite de dialogue s'ouvre pour l'en avertir et lui donner le schéma à saisir.
J'ai créé une fonction pour vérifier cela.
Tout est fait et fonctionnel mise à part le pattern où j'ai un problème pour l'id_echant car je n'arrive pas à intégrer la possibilité d'ajouter une lettre majuscule de A à Z après les chiffres.
Que faut-il que je modifie pour que cela fonctionne comme désiré ?
Je vous remercie pour toute aide.

Voici la fonction en question:

VB:

Option Explicit

Dim reg As Object
Dim verif As Object

Function VerifIDEchant(ByVal strTest As String) As Boolean
    
    'initialisation de l'état
    VerifIDEchant = True
    'Instanciation
    Set reg = CreateObject("vbscript.regexp")
    'Application sur toutes les occurences
    reg.Global = False
    'Ignore la casse
    reg.IgnoreCase = True
    'Pas de recherhce multiligne
    reg.MultiLine = False
     
    'definition du pattern ANNEE-ID_ECHANT-TYPE:
    'annee = 4 chiffres
    'id_echant = 1 à 5 chiffres + possibilité d'une lettre majuscule de A à Z
    'type = BD ou BDC ou E ou W
    reg.Pattern = "^[0-9]{4}[-][0-9]{1,5}[-][BD|BDC|E|W]$"

    'verification de la cellule
    Set verif = reg.Execute(strTest)
    'Erreur
    If verif.Count = 1 Then
        VerifIDEchant = False
    End If
    
    'libération d'objets
    Set verif = Nothing
    Set reg = Nothing
    
End Function

MP59 · 17 Février 2021

Bonjour darkjedi
je te propose d'essayer :

reg.Pattern = "\d{4}-\d{1,5}[A-Z]?-(BD|BDC|E|W)$"

tu n'as pas prévu de - avant cette lettre [A-Z]? (il suffit de l'ajouter - si nécessaire, et -? si ce tiret peut être là ou non).

tu as :
'Ignore la casse
reg.IgnoreCase = True
et ensuite tu parles d'une lettre Majuscule de A à Z ?

Pour info tu peux tester tes Regex sur le site https://regex101.com/r/cO8lqs/14

patricktoulon · 17 Février 2021

MP59
bien vu le pattern
le "^" au début quand même avec le"$" ça implique que la chaine complète doit correspondre au pattern

job75 · 17 Février 2021

Bonjour darkjedi,

regexp ne paraît guère intéressant, voyez plutôt le fichier joint et cette macro dans le code de la feuille :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 Or Target.Row = 1 Or Application.CountA(Target) = 0 Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
If Target.Count > 1 Then MsgBox "L'entrée doit concerner une seule cellule...": Application.Undo: GoTo 1
Dim s, x$, y$
s = Split(Target, " - ")
If UBound(s) <> 2 Then MsgBox "Le texte doit contenir 2 tirets chacun encadré par 2 espaces...": Application.Undo: GoTo 1
If Not s(0) Like "####" Or s(0) < "1900" Then MsgBox "Le 1er texte est l'année et doit être constitué de 4 chiffres...": Application.Undo: GoTo 1
x = s(1)
y = "[A-Z]"
If Not (x Like "#" Or x Like "##" Or x Like "###" Or x Like "####" Or x Like "#####" Or _
    x Like "#" & y Or x Like "##" & y Or x Like "###" & y Or x Like "####" & y Or x Like "#####" & y) _
        Then MsgBox "Le 2ème texte doit être constitué de 1 à 5 chiffres suivi ou non d'une lettre majuscule...": Application.Undo: GoTo 1
x = s(2)
If Not (x = "BD" Or x = "BDC" Or x = "E" Or x = "W") Then MsgBox "Le 3ème texte doit être BD ou BDC ou E ou W...": Application.Undo
1 Application.EnableEvents = True 'réactive les évènements
End Sub

Elle se déclenche quand on entre quelque chose dans une cellule de la colonne A.

A+

patricktoulon · 17 Février 2021

bonsoir @job75
je pense qu'il y a moyen de simplifier tes if pour s(1)

if inumeric (s(1)) or val(s(1)>0
is numeric si c'est un nombre entier
if val si il y a une lettre il y a toujours des chiffres avant donc test concluant pour tout avec ces deux tests

MP59 · 17 Février 2021

Bonjour Patrick,
oui bien sûr, mais c'était bien la demande. Darkjedi les avait mis lui même.

job75 · 17 Février 2021

Bonsoir MP59, patricktoulon,

Désolé quand j'ai posté vos messages n'étaient pas visibles...

Petite modification dans ce fichier (2) pour ne pas obliger l'utilisateur à saisir des majuscules :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column > 1 Or Target.Row = 1 Or Application.CountA(Target) = 0 Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
If Target.Count > 1 Then MsgBox "L'entrée doit concerner une seule cellule...": Application.Undo: GoTo 1
Dim s, x$, y$
s = Split(UCase(Target), " - ") 'texte en majuscule
If UBound(s) <> 2 Then MsgBox "Le texte doit contenir 2 tirets chacun encadré par 2 espaces...": Application.Undo: GoTo 1
If Not s(0) Like "####" Or s(0) < "1900" Then MsgBox "Le 1er texte est l'année et doit être constitué de 4 chiffres...": Application.Undo: GoTo 1
x = s(1)
y = "[A-Z]"
If Not (x Like "#" Or x Like "##" Or x Like "###" Or x Like "####" Or x Like "#####" Or _
    x Like "#" & y Or x Like "##" & y Or x Like "###" & y Or x Like "####" & y Or x Like "#####" & y) _
        Then MsgBox "Le 2ème texte doit être constitué de 1 à 5 chiffres suivi ou non d'une lettre...": Application.Undo: GoTo 1
x = s(2)
If Not (x = "BD" Or x = "BDC" Or x = "E" Or x = "W") Then MsgBox "Le 3ème texte doit être BD ou BDC ou E ou W...": Application.Undo: GoTo 1
Target = UCase(Target) 'entrée en majuscule
1 Application.EnableEvents = True 'réactive les évènements
End Sub

patricktoulon · 17 Février 2021

RE

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim state
    If Target.Column = 1 And Target.Count = 1 Then
        If Target.Value <> "" Then
            With CreateObject("vbscript.regexp")    'Instanciation
                .Global = False: .IgnoreCase = True: .MultiLine = False
                .Pattern = "^\d{4}-\d{1,5}[A-Z]?-(BD|BDC|E|W)$"
                state = .test(Target.Text)
            End With
            If Not state Then Application.Undo: MsgBox "saisie erronée recommencez ": Application.Goto Target
        End If
    End If
End Sub

a noter que je ne neutralise pas application.enableevents

darkjedi · 18 Février 2021

Bonjour à tous,

Et merci pour toute ces propositions.

@MP59
Je vais corriger cela car le schéma ne peut contenir que des lettres majuscules....

tu as :
'Ignore la casse
reg.IgnoreCase = True
et ensuite tu parles d'une lettre Majuscule de A à Z ?

Et je me corrige car je me suis mal exprimé.
L'utilisateur ne saisie rien dans la colonne A.
Celle-ci est remplie automatiquement par les données machine durant le fonctionnement de l'appareil.
Ces données ont été saisie au préalable dans le logiciel machine. Et pour le moment je n'ai pas la main pour vérifier ces données.
Je traite les id_echant à l'issue de la série.
Avant l'appel de la fonction, je vérifie que la cellule à traiter contient bien un id_echant qui commence par 1 chiffre = échantillon. Si la cellule commence par 1 lettre = témoin.
Le traitement est différent selon cela.
Le résultat de la fonction = true permet de continuer la macro appelante
Le résultat de la fonction = false permet de stopper la macro appelante avec suppression de la feuille créée et sélection de la cellule qui pose problème.

Je vais tester ce pattern en remplacant simplement les \d par les [0-9] car en cela est plus explicite pour moi

"^\d{4}-\d{1,5}[A-Z]?-(BD|BDC|E|W)$"

Je reviens pour vous dire comment cela s'est déroulé.
Et merci encore.

darkjedi · 18 Février 2021

Bonjour,

Je viens de tester ce schéma en ajoutant la possibilité de l'espace entre id_echant et la lettre si elle est saisie. Tout est fonctionnel.
Merci à tous.

VB:

"^[0-9]{4}-\[0-9]{1,5}\s?[A-Z]?-(BD|BDC|E|W)$"

XL 2019 [RESOLU] Definir expression régulière

darkjedi

XLDnaute Nouveau

MP59

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

MP59

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

darkjedi

XLDnaute Nouveau

darkjedi

XLDnaute Nouveau

Discussions similaires