Discussion :

[Eperluette]

Bonjour le forum !

Alors voilà, je ne sais pas du tout si cela est possible, mais j'aimerais pouvoir autoriser/empêcher la saisie de certaines données dans une colonne (entrée libre pour l'utilisateur) en fonction des choix faits à partir d'un menu déroulant dans une autre colonne.

Je vais essayer d'être plus claire

Ma colonne A contient une liste déroulante qui limite le choix à 3 codes.
Ma colonne B contient des numéros saisis librement.

En fait, je voudrais empêcher la saisie de doublons dans ma colonne B pour un même code...

Merci à tous pour votre aide !!

[JackOuYA]

Bonjour,

Je te propose une solution VBA. pour cela direction l'éditeur VBE par ALT-F11
rajout à la feuille excel concernée, du code :

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim intTarget As Range
   Dim c As Range
 
  ' Tout d'abords sur modication colonne A on efface tout ce qu'il y as dans colonne b correspondante
   Set intTarget = Intersect(Target, [A:A]) 'Test si dans colonne A (on peu limiter les lignes concernées..')
   If Not intTarget Is Nothing Then
     'Sur modification dans colonne A on efface la B
      intTarget.Offset(0, 1).ClearContents
      Exit Sub
   End If
 
 
   Set intTarget = Intersect(Target, [B:B])
   If Not intTarget Is Nothing Then
     For Each c In intTarget
      Debug.Print "traite " & c.Address
      If VerifieSiExiste(Intersect([A1].CurrentRegion, [A:A]), c) Then
         MsgBox "Déjà existant : " & c.Offset(0, -1) & "==>" & c
         c.ClearContents
      End If
     Next
   End If
End Sub

Rajout d'un module de code avec la fonction :

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
Function VerifieSiExiste(rAparcourir As Range, Target As Range) As Boolean
 Dim c As Range
 If Target.Value = "" Then
   VerifieSiExiste = False
   Exit Function
 End If
 For Each c In rAparcourir
       If c.Row <> Target.Row Then
           If Target.Offset(0, -1) = c And Target = c.Offset(0, 1) Then
             VerifieSiExiste = True
             Exit Function
           End If
 
       End If
  Next
 VerifieSiExiste = False
End Function

[Gorfael]

SalutEperluette et le forum
Tu peux créer une MFC avec une formule du genre :
=SOMMEPROD(($B$1:$B$10000<>"")*($A$1:$A$10000 &$B$1:$B$10000 = A1&B1)*1)>1
avec un fond rouge par exemple : les 2 lignes dont A et B sont égales (en les concaténant ça devrait suffire vu les données) passe en rouge à la validation
On peut faire que seul le doublon passe en rouge.
Après tout dépend de ce que tu entends par "empêcher"
A+

[Eperluette]

Salut le forum !

Tout d'abord un grand merci à JackOuYA et Gorfael d'avoir répondu si vite

Gorfael, tu as raison j'aurais dû préciser cela : idéalement je voudrais signaler à l'utilisateur que sa saisie a déjà été entrée pour le code sélectionné, et donc empêcher la saisie du doublon en proposant une nouvelle saisie par exemple.

En ce sens la solution VBA de JackOuYA me semble vraiment bien adaptée, mais je retiens l'idée d'une MFC : c'est tout pratique pour identifier rapidement les doublons dans un document.

JackOuYA, j'ai testé ta solution et ça marche super bien, merci beaucoup !
Par contre je me demandais s'il y aurait moyen de l'adapter pour tout le classeur, de façon à rechercher dans toutes les feuilles (3 au total), avec par exemple un message qui dirait 'La valeur X (c'est celle de la colonne B) a déjà été entrée pour le Code Y (c'est la sélection de la colonne A) dans la feuille X, cellule Y' ?

Si en plus il y avait moyen d'installer un genre de bouton qui permette de se téléporter d'un clic de souris jusqu'à la cellule déjà entrée, et un autre qui permette de modifier sa saisie par exemple alors là ce serait carrément top !

Bon je crois que j'en demande beaucoup là

En tout cas merci pour votre aide jusqu'à présent, ça fait vraiment plaisir !!

PS: ci-joint petit fichier d'exemple.

[JackOuYA]

Bonsoir,

Tu peu adapter le code en le plaçant dans "ThisWorkbook"

Code :

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

1
2
3
4
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 
End Sub

il faudra alors rajouter au test de la plage modifié (déjà effectué savoir si colonne A) , le test de la feuille (savoir si tu est dans la bonne page.)

ensuite pour ton bouton .. je sais pas trop tu peu utiliser un userform personnalisé, avec les objets sh et Target tu connais les endroit à atteindre .

Où bien modifier le messagebox en choix " OK ou Abandon"

Code :

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

If MSgbox ("Existe déjà, voulez vous l'atteindre ",vbOKCancel )=vbOK Then ..

dis nous si tu bloque..

[Eperluette]

Salut Jacques et le forum,

Merci beaucoup pour ta réponse Jacques ! Euh... en fait je débute un peu (beaucoup) avec VBA et je crois que je vais encore avoir besoin de ton aide

J'ai bricolé un petit peu le code mais ça ne marche pas... J'ai placé le code dans 'ThisWorkbook' puis j'ai essayé de rajouter 'Sheets(i).' pour chercher dans toutes les feuilles, comme ça :

Code :

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

Set intTarget = Intersect(Target, Sheets(i).[A:A])

J'ai aussi essayé de modifier le message box comme ça :

Code :

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

1
2
3
If VerifieSiExiste(Intersect([A1].CurrentRegion, Sheets(i).[A:A]), c) Then
         MsgBox ("Déjà existant : " & c.Offset(0, -1) & "==>" & c
         c.ClearContents & "voulez vous l'atteindre ",vbOKCancel )=vbOK

Donc pour le moment le code ressemble à ça :

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim intTarget As Range
   Dim c As Range
 
  ' Tout d'abords sur modication colonne A on efface tout ce qu'il y as dans colonne b correspondante
   Set intTarget = Intersect(Target, Sheets(i).[A:A]) 'Test si dans colonne A (on peu limiter les lignes concernées..')
   If Not intTarget Is Nothing Then
     'Sur modification dans colonne A on efface la B
      intTarget.Offset(0, 1).ClearContents
      Exit Sub
   End If
 
 
   Set intTarget = Intersect(Target, [B:B])
   If Not intTarget Is Nothing Then
     For Each c In intTarget
      Debug.Print "traite " & c.Address
If VerifieSiExiste(Intersect([A1].CurrentRegion, Sheets(i).[A:A]), c) Then
         MsgBox ("Déjà existant : " & c.Offset(0, -1) & "==>" & c
         c.ClearContents & "voulez vous l'atteindre ",vbOKCancel )=vbOK
End If
     Next
   End If
End Sub

Je me rends bien compte que j'ai dû faire plein d'erreurs, mais je ne vois pas comment faire... Arg !

[Gorfael]

Salut Eperluette
j'ai juste jeté un cil rapide sur ta macro:
Set intTarget = Intersect(Target, Sheets(i).[A:A])
tu commences ton traitement, mais où est défini i ?
Je te conseillerais de t'obliger à déclarer tes variables, c'est chiant, mais ça te permet d'éviter des oublis et les fautes de frappe..

De plus, quand tu fixe inTarget pour la seconde fois, tu ne t'occupes plus de la feuille => donc, c'est la feuille active qui est traitée.

Les indentations dans un code doivent être là pour t'aider, pas pour autre chose : ça te permet de voir le code de la partie VRAI/FAUX d'un test, ou si tu es dans une boucle. Con^trôle, juste du visuel :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Set intTarget = Intersect(Target, [B:B])
If Not intTarget Is Nothing Then
    For Each c In intTarget
        Debug.Print "traite " & c.Address
        If VerifieSiExiste(Intersect([A1].CurrentRegion, Sheets(i).[A:A]), c) Then
            MsgBox("Déjà existant : " & c.Offset(0, -1) & "==>" & c & _
                   "voulez vous l'atteindre ", vbOKCancel) = vbOK
            'modifiée pour qu'Excel passe pas la ligne en rouge
        End If
    Next
End If

tu vois ou commence/fini les test, la boucle, etc...
Euh... pas compris ta MsgBox
A+

[Eperluette]

Salut Gorfael,

Merci pour ta réponse, mais euh... je débute vraiment, donc je n'y comprends rien de rien... Je me suis mise à VBA il y a une semaine, en cherchant des bouts de codes que j'essaie d'adapter en fonction de ce que je voudrais faire, avec comme tu l'imagines un succès très limité vu mon petit niveau ! Par exemple je ne sais pas comment définir une variable (en fait je ne suis même pas sûre de ce que c'est qu'une variable). InTarget, feuille active et incidentations c'est carrément une autre langue pour moi

La message box, j'essayais d'obtenir une fenêtre qui
1. identifie où (feuille, cellule) la valeur existe déjà
2. propose ensuite à l'utilisateur soit d'aller directement à la feuille/cellule déjà entrée, soit d'effectuer une nouvelle saisie
(avec suppression de la valeur que l'utilisateur a tenté d'entrer)

Merci pour ton aide dans tous les cas.

[Eperluette]

Hello,

Voilà, j'ai essayé de retravailler le code toute seule mais je n'y arrive pas...
Est-ce que quelqu'un pourrait m'aider ? J'espère n'avoir offensé personne avec mes précédents messages...

Merci beaucoup !

[JackOuYA]

Bonjour,

Comme j'ai commencé .. enléve le code précédent dans ta feuille 1

le code à mettre dans thisWorkBook :

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
36
37
 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim intTarget As Range
Dim c As Range
Dim cTrouve As Range
Dim f As Worksheet
 'Teste si feuille concernée par exemple nom qui commence par DATA
  If Left(Sh.Name, 5) = "DATA " Then
    Debug.Print "traite feuille" & Sh.Name
 
 
  ' Tout d'abords sur modication colonne A on efface tout ce qu'il y as dans colonne b correspondante
    Set intTarget = Intersect(Target, [A:A]) 'Test si dans colonne A (on peu limiter les lignes concernées..')
    If Not intTarget Is Nothing Then
        'Sur modification dans colonne A on efface la B
        intTarget.Offset(0, 1).ClearContents
        Exit Sub
    End If
 
   Set intTarget = Intersect(Target, [B:B])
   If Not intTarget Is Nothing Then
    For Each f In ThisWorkbook.Sheets 'Parcours toutes les feuilles
        If Left(Sh.Name, 5) = "DATA " Then
            For Each c In intTarget
                Debug.Print "traite " & c.Address
                Set cTrouve = ChercheChamp(Intersect(f.[A1].CurrentRegion, f.[A:A]), c)
                If Not cTrouve Is Nothing Then
                  MsgBox c.Offset(0, -1) & "==>" & c & " Existe ici: " & cTrouve.Parent.Name & "!" & cTrouve.Address
                    c.ClearContents
                End If
            Next
        End If
    Next
   End If
 
  End If
End Sub

La nouvelle fonction ChercheChamp (variante de VérifieSiExiste qui renvoi champ recherché) à mettre dans ton module

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
'
' Fonction verifieSiExiste modifiée renvoi la premiére égalité trouvé
'
Function ChercheChamp(rAparcourir As Range, Target As Range) As Range
 Dim c As Range
 If Target.Value = "" Then
   VerifieSiExiste = False
   Exit Function
 End If
 For Each c In rAparcourir
       If c.Row <> Target.Row Or c.Parent.Name <> Target.Parent.Name Then 'Vérifie si pas la même cellule
           If Target.Offset(0, -1) = c And Target = c.Offset(0, 1) Then
             Set ChercheChamp = c
             Exit Function
           End If
       End If
  Next
Set ChercheChamp = Nothing
End Function
 
dit nous quoi

[Gorfael]

Salut Eperluette
Les retards, abandons, etc…. font parties des aléas des forums. C’est pas cher, mais on ne sait jamais si, quand et comment on aura la réponse (toujours urgent)

Vais faire un petit récapitulatif de ce que je comprends
En A une liste de validation
En B une saisie manuelle

Le but : éviter les doublons A & B, doublons pouvant se situer sur n'importe quelle feuille du classeur

Comme je sais plus où on en est, je vais expliquer comment je résoudrais un tel problème :

- Comme c'est à la saisie qu'on veut avertir, on utilise une macro à lancement automatique et comme c'est sur plusieurs feuilles, on utilisera Workbook_SheetChange. Cette macro fournit 2 variable : la feuille et les cellules modifiées. Pour faire simple, on va simplement compter le couple A & B qui vient d'être modifié au travers de toutes les feuilles s'il y en a plus d'un, j'ai doublon. S'il n'y en a qu'un, c'est celui qui vient d'être saisi.
Il va donc falloir regarder les colonnes A et B : tout changement dans A doit contrôler l'unicité de A & B. De même que tout changement dans B
Ce qui nous impose une première condition : la macro ne contrôlera que si A B sont remplies. Si on ne travaillait que sur B, on imposerait que A soit remplie (par exemple), mais comme on veut s'assurer qu'il n'y aura pas un doublon en modifiant A après avoir vérifier A & B, on n’a pas le choix. Et comme on ne peut pas remplir les 2 cellules en même temps (la plupart du temps).

De même, il va falloir tenir compte d'une modification plage multi-cellules (hors de question d'avoir une erreur en effaçant 1 ligne).
Pour la recherche de doublon, comme A est limité à 3 possibilités, je chercherais sur B (si j'utilises Find)

Après la question est : si je trouves un doublon, quoi faire ?
Comme je ne veux pas de doublon, j'efface A et B que j'étais en train de saisir, et je place le curseur sur les valeurs existantes.
J'ai à peu près défini mon algorithme, reste à le coder.
En créant le code, on modifie l’algorithme, en fonction des possibilités qu’on avait omises au départ. Exemple : on peut faire du copier/coller sur plusieurs feuilles. Au niveau privé, ça ne se fera jamais, mais au niveau professionnel, on ne sait jamais à quelles manipulations on va être confronté. Donc, même si c’est improbable, mais que ce n’est pas impossible, on doit le traiter.
Avec une telle hypothèse, je ne peux plus suprimer la nouvelle saisie et aller sur l’ancienne. Comme la priorité reste les doublons, je vais masquer toutes les lignes ne contenant pas de doublons.
2 macros à coller dans le module ThisWorkBook : l'affichage des doublons

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Déclarations ============================================
Dim Cel As Range
Dim F As Worksheet
Dim Tab_V()
Dim Doublon()
Dim X As Long, Y As Long
Dim Flg As Boolean
Dim AAA As String
'Validit =================================================
If Intersect(Target, Sh.Range("A:B")) Is Nothing Then Exit Sub
'si ça ne concerne pas A ou B, on sort
'MEI =====================================================
ReDim Tab_V(1 To 4, 0 To 0)
'dimensionnement du tableau : 1 ligne de 4 colonnes par cellules
'Chargement du tableau ===================================
Flg = True
'Drapeau à Vrai
For Each Cel In Intersect(Target, Sh.Range("A:B"))
'chaque cellule contenue dans
'intersection cellules modifiées-colonnes A ou B de la feuille en cours
    If Not (IsEmpty(Sh.Cells(Cel.Row, "A")) Or IsEmpty(Sh.Cells(Cel.Row, "B"))) Then
    'les colonnes A et B de la ligne de la cellule ne sont pas vide
        For X = 0 To UBound(Tab_V, 2)
        'pour x= 1 à dernier indice 2 du tableau
            If Tab_V(4, X) = Cel.Row Then
            'si la ligne de la cellule en cours est égale à la colonne
            '4 de la ligne du tableau testée (onglet reste le même)
                Flg = False
                'drapeau à Faux
                Exit For
                'sortir de la boucle
            End If
        Next X
        If Flg Then
        'si drapeau à vrai
            ReDim Preserve Tab_V(1 To 4, 0 To UBound(Tab_V, 2) + 1)
            'augmenter de 1 le nb de lignes du tableau en conservant les
            'variables déjà remplies
            Tab_V(1, UBound(Tab_V, 2)) = Cells(Cel.Row, "A")
            '1re colonne = A
            Tab_V(2, UBound(Tab_V, 2)) = Cells(Cel.Row, "B")
            '2me colonne = B
            Tab_V(3, UBound(Tab_V, 2)) = Sh.Name
            '3me colonne = nom de la feuille
            Tab_V(4, UBound(Tab_V, 2)) = Cel.Row
            '4me colonne = n°ligne
        Else
            Flg = True
        End If
    End If
Next Cel
'validité de recgerche des doublons ======================
If UBound(Tab_V, 2) = 0 Then Exit Sub
'si l'indice max de ligne est resté à 0, on sort
ReDim Doublon(1 To 2, 0 To 0)
'initialisation tableu 2 indice (1 à 2, 0 à 0)
'Recherche et stockage des doublons ======================
For Each F In ThisWorkbook.Sheets
'pour chaque feuille de ce classeur
    For Y = 1 To IIf(F.Range("B65536").End(xlUp).Row > F.Range("A65536").End(xlUp).Row, _
                     F.Range("A65536").End(xlUp).Row, F.Range("B65536").End(xlUp).Row)
    'Pour Y=1 à si(dernière ligne en B > dernière ligne en A alors A sinon B)
        For X = 1 To UBound(Tab_V, 2)
        'pour x=1 à dernier indice du 2ème indice
            If Tab_V(1, X) = F.Range("A" & Y) And _
                        Tab_V(2, X) = F.Range("B" & Y) And _
                       (Tab_V(3, X) <> F.Name Or _
                        Tab_V(4, X) <> Y) Then
            'si A ET B = TAB_V(A & B) ET
             '[(onglet<>tab_v(onglet)) ou (lig<>tab_v(lig)] alors
                ' traitement doublon
                ReDim Preserve Doublon(1 To 2, 0 To UBound(Doublon, 2) + 2)
                'on ajoute 2 à l'indice max
                Doublon(1, UBound(Doublon, 2) - 1) = F.Name
                Doublon(2, UBound(Doublon, 2) - 1) = Y
                Doublon(1, UBound(Doublon, 2)) = Tab_V(3, X)
                Doublon(2, UBound(Doublon, 2)) = Tab_V(4, X)
                Exit For
             End If
        Next X
    Next Y
Next F
'validité d'affichage des doublons =======================
If UBound(Doublon, 2) = 0 Then Exit Sub
'si le max du 2me indice de doublon =0 on sort
'affichage des doublons ==================================
For X = 1 To UBound(Doublon, 2)
    With Sheets(Doublon(1, X))
    'mise en préfixe de la feuille
        If .Rows(1).Hidden = False Then
        'si la 1re ligne(ligne de titre) n'est pas masquée, alors
            .UsedRange.Rows.Hidden = True
            'le point en début rajoute le préfixe
            'on masque les lignes
        End If
        .Rows(Doublon(2, X)).Hidden = False
        'on affiche la ligne du doublon
    End With
Next X
MsgBox Chr(13) & "Les lignes affichées contiennent des doublons" & _
       Chr(13) & "merci de les traiter" & Chr(13), vbCritical + vbOKOnly, _
       "DOUBLONS TROUVÉS"
End Sub

elle est forcément perfectible, mais peut servir de base pour voir ce qui se passe avec un point d'arrêt sur le titre et en avançant pas-à-pas avec F8 dans VBE (afficher la fenêtre variable locale).
on pourrait par exemple remonter le scrolling pour avoir la première ligne affichée en début de fenêtre.
2me macro :réafficher toutes les lignes, après traitement des doublons

Code :

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

1
2
3
4
5
6
Sub réaffichage()
Dim F As Worksheet
For Each F In ThisWorkbook.Sheets
    F.UsedRange.Rows.Hidden = False
Next F
End Sub

Comme on le voit, une macro est une démarche personnelle : celle de JackOuYA n'est pas la même. Et quand je ne suis pas le seul utilisateur de ma macro, j'essaie de la blinder pour qu'elle ne soit jamais en défaut. Où, su moins, dans les cas que j'envisage. Mais j'ai 2 avantages sur un pro : d'abors, je suis assez vicieux pour chercher comment truquer le résultat attendu et ensuite (et surtout), je n'ai pas un clown qui me souffle dans le cou en me demandant si ça va rurer encore longtemps, parce que ça devrait déjç être fini .
A+

[Invité]

Bonjour,

Une méthode simple de listes en cascade (voir PJ).

JB