Discussion :

[Paloma]

Bonjour à tous et à toutes,

J'ai un souci, en fait, j'ai besoin de vérifier ce qui a été saisie dans une cellule (de la colonne 2) par un utilisateur.


En fait, l'utilisateur ne peut saisir que 2 ou 4 chiffres mais il y a des exception, il doit aussi pouvoir si besoin ajouter une lettre en capital. De plus il peut aussi entrer un nombre avec des zéros à la fin (exemple: 3000).

Je résume, il peut donc saisir :

34, 000A

2 chiffres ou 4 chiffres + 1 lettre en majuscule

------------------------------------------------------------
3450, 9960A

4 chiffres ou 4 chiffres + 1 lettre en majuscule,
mais le quatrième chiffre peut avoir un zéro
------------------------------------------------------------

7835 , 7835G

4 chiffres ou 4 chiffres + 1 lettre en majuscule

Pour valider la saisie à chaque entrée de l'utilisateur, j'utilise l'outil validation d'Excel.



Comment peut-on autoriser une lettre en plus ?

Peut-on remplacer l'outil validation par du code automatique à placer dans la feuille correspondante ?

Merci pour votre aide.

[Many31]

Je connais mal les fonctions Excel et je préfère le VBA.

Voici les éléments de réponse en macro:

1) utiliser l'événement Worksheet_Change
2) Utiliser la fonction Like

Exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target Like "O?I" Then MsgBox "It's OK"
End Sub

les codes de correspondance:
? Tout caractère unique.
* Aucun ou plusieurs caractères.
# Tout chiffre unique (de 0 à 9).
[charlist] Tout caractère unique compris dans l'argument charlist.
[!charlist] Tout caractère unique non compris dans l'argument charlist.

Tu peux aussi mettre une condition sur Target (Target.Row pour par exemple n'appliquer la condition que sur une ligne donnée etc.)

Voila

[Gorfael]

Salut Paloma et le forum
Une proposition par macro :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msg_Err As String
If Target.Cells.Count <> 1 Or Intersect(Target, Columns(4)) Is Nothing Or _
    IsEmpty(Target) Then Exit Sub
'si on modifie plus d'une cellule ou si celle-ci n'appartient pas à D, On sort
Select Case Len(Target)
    Case 2
        If Not (Target Like "##") Then Msg_Err = "2 chiffres"
    Case 4
        If Not (Target Like "####") Then Msg_Err = "4 chiffres"
    Case 5
        If Not (Target Like "####[A-Z]") Then Msg_Err = "4 chiffres et 1 majuscule"
    Case Else
        Msg_Err = "2 chiffres,4 chiffres ou 4 chiffres et 1 majuscule"
End Select
If Msg_Err <> "" Then
    MsgBox Msg_Err, vbCritical + vbOKOnly, "erreur de saisie"
    Target.ClearContents
End If
End Sub

Cette macro suppose que la colonne D est définie au format Texte (permettant d'avoir "0000").
A+

[Paloma]

Bonjour Gorfael et Many31,

D'abord, merci à vous deux.

Mais je me suis mal expliqué et mon 'algo' n'était pas complet.
En fait, l'utilisateur ne doit pouvoir saisir que deux 'Digits' (chiffres au format ##) ou deux 'Digits' (chiffres au format ##) et un caractère (qui peut être un chiffre de [0-9] ou [A-H] ou [J-N] ou [P-N].

J'ai essayé de modifire le code mais ça ne marche pas, je crois que je prend le pb à l'envers. J'y réfléchi mais si vous avez plus d'info.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
 
Dim Msg_Err As String
 
If Target.Cells.Count <> 1 Or Intersect(Target, Columns(4)) Is Nothing Or _
    IsEmpty(Target) Then Exit Sub
'If more than one cell is modified or if the cell is not in the 'D' column, go out !
Select Case Len(Target)
    Case 2
        If Not (Target Like "##") Then Msg_Err = "2 Digits"
    Case 4
        If Not (Target Like "####") Then Msg_Err = "4 Digits"
    Case 5
        If Not (Target Like "####[0-9]") Then Msg_Err = "4 Digits and 1 Number"
        ' or
        If Not (Target Like "####[A-H]") Then Msg_Err = "4 Digits and 1 Char in upper case"
        ' or
        If Not (Target Like "####[J-N]") Then Msg_Err = "4 Digits and 1 Char in upper case"
        ' or
        If Not (Target Like "####[P-Z]") Then Msg_Err = "4 Digits and 1 Char in upper case"
    Case Else
        Msg_Err = "2 Digits,4 Digits or 4 Digits and 1 Char in upper case"
End Select
If Msg_Err <> "" Then
    MsgBox Msg_Err, vbCritical + vbOKOnly, "erreur de saisie"
    Target.ClearContents
End If
 
  If Target.Column = 4 And Target.Count = 1 Then 
     Target = UCase(Target)
  End If
 
  Application.EnableEvents = True
End Sub

Merci à vous tous.

[Krovax]

Bonjour
un premier souci de raisonnement
j'entre
1111H

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
  If Not (Target Like "####[0-9]") Then Msg_Err = "4 Digits and 1 Number" 'ici j'ai un message
        ' or
        If Not (Target Like "####[A-H]") Then Msg_Err = "4 Digits and 1 Char in upper case" 'ici c'est bon
        ' or
        If Not (Target Like "####[J-N]") Then Msg_Err = "4 Digits and 1 Char in upper case"  'ici j'ai un message
        ' or
        If Not (Target Like "####[P-Z]") Then Msg_Err = "4 Digits and 1 Char in upper case"  'ici j'ai un message

Donc dans 3 cas il y a un message Msg_Err = "4 Digits and 1 Char in upper case"

Tes 'or ne serve a rien alors qu'il devrais être utilisé
il faut que ca soit
au format
"####[P-Z]" OU "####[J-N]" OU "####[A-H] OU "####[0-9]"
Un peu d'algèbre de boule
non "####[0-9]" ET non "####[A-H] ET non "####[J-N]" ET non "####[P-Z]"

Donc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not (Target Like "####[0-9]") AND  Not (Target Like "####[A-H]") AND  Not (Target Like "####[J-N]") AND Not (Target Like "####[P-Z]") then Msg_Err = "4 Digits and 1 Char in upper case"  'ici j'ai un message

Je n'ai pas regardais le reste mais ceci m'a violemment sauté aux yeux

[Paloma]

Bonjour Krovax,

Merci, je vais regarder ça.
Mais en fait ce que j'essaye de faire, c'est que si l'utilisateur saisie autre chose, un message d'erreur doit apparaitre pour lui dire qu'il ne peut saisir que 2 digits ou 2 digits et un caractère (qui peut être un chiffre de [0-9] ou [A-H] ou [J-N] ou [P-N].

D'ou le message d'erreur apparait s'il fait :
- 234
- 234566
- 4567AA
- 2345A2
- A
- 1
- 'Blank' ...
- A232A
- A3456
etc ...

Merci pour vos lumières.
En attendant, je regarde votre code et l'essaye tout de suite.

modif:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
'--------------------------------------------------------------------------
'    Automatic checks capture
'
'--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
 
Dim Msg_Err As String
 
If Target.Cells.Count <> 1 Or Intersect(Target, Columns(4)) Is Nothing Or _
    IsEmpty(Target) Then Exit Sub
'If more than one cell is modified or if the cell is not in the 'D' column, go out !
Select Case Len(Target)
    Case 2
        If Not (Target Like "##") Then Msg_Err = "2 Digits"
    Case 4
        If Not (Target Like "####") Then Msg_Err = "4 Digits"
    Case 5
        If Not (Target Like "####[0-9]") And Not (Target Like "####[A-H]") And Not (Target Like "####[J-N]") And Not (Target Like "####[P-Z]") Then Msg_Err = "4 Digits and 1 Char in upper case"    'ici j'ai un message
    Case Else
        Msg_Err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case"
End Select
If Msg_Err <> "" Then
    MsgBox Msg_Err, vbCritical + vbOKOnly, "erreur de saisie"
    Target.ClearContents
End If
 
  If Target.Column = 4 And Target.Count = 1 Then 
     Target = UCase(Target)
  End If
 
  Application.EnableEvents = True
End Sub

De plus, peut-on avoir 2 "Private Sub Worksheet_Change(ByVal Target As Range)" si je leur donne des noms différents dans la même feuille ?
Par exemple :

Private Sub Worksheet_A_Change(ByVal Target As Range)
Private Sub Worksheet_B_Change(ByVal Target As Range)

[Krovax]

Je viens de remarqué un truc
[J-N] ou [P-N].

le premier permet J K L M N
le deuxième P N
je ne sais pas si c'est ce que tu veux faire

Oui tu peut avoir
Private Sub Worksheet_A_Change(ByVal Target As Range)
Private Sub Worksheet_B_Change(ByVal Target As Range)
dans la m^me feuille mais aucun ne se déclenchera
Seul
Private Sub Worksheet_Change(ByVal Target As Range)

Se déclenche
Le plus simple est de faire plusieur test sur target

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Change(ByVal Target As Range)
If not intersect(Target,Range("A1:B5")) is nothing then
   Msgbox "Vous avez cliqué dans la première zone"
elseif not intersect(Target,Range("D8:F15")) is nothing then
   Msgbox "Vous avez cliqué dans la Deuxième zone"
elseif not intersect(Target,Range("G:G")) is nothing then
   Msgbox "Vous avez cliqué dans la Troisième zone"
end if
End sub

Ce qui va te forcer a faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
If Target.Cells.Count = 1 AND not Intersect(Target, Columns(4)) Is Nothing AND not_
    IsEmpty(Target) Then 
'ta macro
 
elseif Test de ta deuxème zone then
ta nouvelle macro
end if

[Paloma]

Je crois que j'ai réussi à obtenir ce que je voulais.

Qu'en pensez-vous?
Et noublions pas que c'est grace à vous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
'--------------------------------------------------------------------------
'    Automatic checks capture
'
'--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
  Application.EnableEvents = False
 
Dim Msg_Err As String
 
If Target.Cells.Count <> 1 Or Intersect(Target, Columns(4)) Is Nothing Or _
    IsEmpty(Target) Then Exit Sub
'If more than one cell is modified or if the cell is not in the 'D' column, go out !
Select Case Len(Target)
    Case 2
        If Not (Target Like "##") Then Msg_Err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case"
    Case 4
        If Not (Target Like "####") Then Msg_Err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case"
    Case 5
        If Not (Target Like "####[0-9]") And Not (Target Like "####[A-H]") And Not (Target Like "####[J-N]") And Not (Target Like "####[P-Z]") And Not (Target Like "####[a-h]") And Not (Target Like "####[j-n]") And Not (Target Like "####[p-z]") Then Msg_Err = "4 Digits and 1 Char in upper case"   'ici j'ai un message
    Case Else
        Msg_Err = "Please enter 2 Digits or 2 Digits and 1 Char in upper case"
End Select
If Msg_Err <> "" Then
    MsgBox Msg_Err, vbCritical + vbOKOnly, "Data : Error"
    Target.ClearContents
End If
 
  If Target.Column = 4 And Target.Count = 1 Then 
     Target = UCase(Target)
  End If
 
  Application.EnableEvents = True
End Sub

Merci Krovax pour votre réponse.

Merci encore à vous tous.