[XL-2007] Interdire saisie doublon [Résolu]

[apt]

Bonsoir à tous,

J'ai essayé d'interdire la saisie d'un doublon avec le code suivant, mais rien d'obtenu :

Code :

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Plage As Range, Trouve As Range
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    If Target.Column = 1 And Target.Count = 1 Then
        Set Plage = Range([A6], [A65000].End(xlUp).Offset(-1, 0))
        Set Trouve = Plage.Find(What:="0" & Target.Value, After:=Target.Offset(1, 0), _
                                LookIn:=xlValues, lookat:=xlPart, _
                                searchdirection:=xlNext)
 
        If Not Trouve Is Nothing Then
            If Trouve.Address <> Target.Address Then
                '---
                MsgBox "Le N° 0" & Trouve.Value & " est déjà saisie à la ligne " & Trouve.Row, vbCritical, "DOUBLON"    'message d'erreur
                Target.Value = ""    'efface la valeur éditée
                Target.Select    'place le curseur dans la cellule Active
 
            End If
        Else
            Target.NumberFormat = "0##"" ""##"" ""##"" ""##"
        End If
    End If
 
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Et comme le format de la première cellule est :

Target.NumberFormat = "0##"" ""##"" ""##"" ""##"

Alors vous pouvez remarquez un "0" ajouter devant le mot recherché dans Plage.find

Merci d'avance.

[mercatog]

Code :

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change(ByVal Target As Range)
 
If Target.Column = 1 And Target.Row > 5 And Target.Count = 1 Then
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End If
End Sub

[apt]

Bonsoir mercatog,

Ca marche, merci.

Mais comment savoir la ligne du doublon ?

[mercatog]

EDIT

J'ai changé la paramètre After et supprimé un IF non nécessaire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
 
If Target.Column = 1 And Target.Row > 5 And Target.Count = 1 Then
    If Application.CountIf(Range("A:A"), Target.Value) > 1 Then
        Set c = Range("A:A").Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)
        MsgBox "Doublon en ligne " & c.Row
        Set c = Nothing
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
    End If
End If
End Sub

[apt]

J'ai fait quelques modifications sur le code (Définition de la plage de recherche) et hop la sasie des doublons est permise

Code :

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 c As Range
 
    If Target.Column = 1 And Target.Row > 5 And Target.Count = 1 Then
        Set Plage = Range("A6:A" & [A65000].End(xlUp).Offset(-1, 0).Row)
        MsgBox "Plage = " & Plage.Address
        If Application.CountIf(Plage, Target.Value) > 1 Then
            Set c = Plage.Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target)
            If Not c Is Nothing Then
                MsgBox "Doublon en ligne " & c.Row
                Set c = Nothing
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
        Else
            Target.NumberFormat = "0##"" ""##"" ""##"" ""##"
        End If
    End If
End Sub

Ou est l'erreur ?

Merci.

[mercatog]

Code :

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 c As Range, Plage As Range
 
If Target.Column = 1 And Target.Row > 5 And Target.Count = 1 Then
    Target.NumberFormat = "0##"" ""##"" ""##"" ""##"
    Set Plage = Range("A6:A" & [A65000].End(xlUp).Row)
    MsgBox "Plage = " & Plage.Address
    If Application.CountIf(Plage, Target.Value) > 1 Then
        Set c = Range("A:A").Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)
        If Not c Is Nothing Then
            MsgBox "Doublon en ligne " & c.Row
            Set c = Nothing
            Application.EnableEvents = False
            Target.Clear
            Application.EnableEvents = True
        End If
    End If
    Set Plage = Nothing
End If
End Sub

Ton erreur est dans la définition de Plage et Find

[apt]

Bonsoir mercatog,

Pour que ça marche il faut mettre un 1 à la place de 0 dans la ligne :

Code :

If Application.CountIf(Plage, Target.Value) > 1 Then

Avec la même définition de Plage à savoir :

Code :

Set Plage = Range("A6:A" & [A65000].End(xlUp).Offset(-1, 0).Row)

Parce que la dernière ligne active qu'on est en train de saisir ne devra pas entrer dans la plage de recherche pour éviter des erreurs.


Mais pourquoi la recherche ne fonctionne pas dans :

Code :

Set c = Plage.Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)

Mais fonctionne dans

Code :

Set c = Range("A:A").Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)

[mercatog]

Le code tel #6 fonctionne chez moi sans restriction et tu peux saisir la nouvelle donnée en bas dans une nouvelle cellule, en milieu ou en début de ta colonne A.
Sans un If non nécessaire

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, Plage As Range
 
If Target.Column = 1 And Target.Row > 5 And Target.Count = 1 Then
    Target.NumberFormat = "0##"" ""##"" ""##"" ""##"
    Set Plage = Range("A6:A" & [A65000].End(xlUp).Row)
    If Application.CountIf(Plage, Target.Value) > 1 Then
        Set c = Range("A:A").Find(Target.Text, LookIn:=xlValues, lookat:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)
        MsgBox "Doublon en ligne " & c.Row
        Set c = Nothing
        Application.EnableEvents = False
        Target.Clear
        Application.EnableEvents = True
    End If
    Set Plage = Nothing
End If
End Sub

[apt]

Bonsoir mercatog,

Ton code marche bien et je l'ai ainsi adapter en changeant la ligne :

Code :

Set C = Range("A:A").Find(Target.Text, LookIn:=xlValues, LookAt:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)

par la ligne

Code :

Set C = Plage.Find(Target.Value, LookIn:=xlFormulas, LookAt:=xlWhole)

Parce que je ne comprenais pas pourquoi la recherche ne se faisait que sur Range("A:A") et pas Plage

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, Plage As Range
    '-- Partie pour eviter de saisir des doublons
    Target.NumberFormat = "0##"" ""##"" ""##"" ""##"
    Set Plage = Range("A6:A" & [A65000].End(xlUp).Row)
    MsgBox "Plage = " & Plage.Address
    If Application.CountIf(Plage, Target.Value) > 0 Then
        'Set C = Range("A:A").Find(Target.Text, LookIn:=xlValues, LookAt:=xlWhole, After:=Target.Offset(1, 0), SearchDirection:=xlNext)
        Set c = Plage.Find(Target.Value, LookIn:=xlFormulas, LookAt:=xlWhole)
 
        If Not c Is Nothing Then
            MsgBox "Doublon en ligne " & c.Row
            Set c = Nothing
            Application.EnableEvents = False
            Target.Clear
            [A65000].End(xlUp).Offset(1, 0).Select
            Application.EnableEvents = True
        End If
    End If
    Set Plage = Nothing
 
    '--- Fin partie traitment des saisies
End Sub

[gFZT82]

Bonjour,

Si tu codes

Code :

Application.CountIf(Plage, Target.Value) > 0

toute nouvelle saisie sera effacée, même s’il ne s’agit pas d’un doublon.
d’où l’intérêt de coder

Code :

Application.CountIf(Plage, Target.Value) > 1

Cordialement.

[apt]

Bonjour gFZT82,

> 0 ==> au moins (1) une occurence => pas de doublon

> 1 ==> au moins (2) deux occurences => il y a doublon.


j'ai bien compris.

merci gFZT82