XL 2010 Détection automatique des doublons

[whiteshark]

Bonjour à tous !
J'ai récupéré ce code en cherchant sur le net, que j'ai ensuite adapté, pour chercher les numéros en doublons sur ma colonne B à partir de la cellule B3 (B1 et B2 sont pour l'en-tête).

Sub Doublons()
Dim D1, D2, P As Range, C As Range, a(), n As Long, L As String
'[B:B].Interior.ColorIndex = xlNone
Set D1 = CreateObject("Scripting.Dictionary")
Set P = Range("B3", [B65000].End(xlUp))
For Each C In P
If C.Value <> 0 Then D1.Item(C.Value) = D1.Item(C.Value) + 1
If C.Value <> "" Then D1.Item(C.Value) = D1.Item(C.Value) + 1
Next
Set D2 = CreateObject("Scripting.Dictionary")
For Each C In P
If D1.Item(C.Value) > 1 Then
'C.Interior.ColorIndex = 3
If D2(C.Value) = "" Then D2(C.Value) = C
End If
Next
a = D2.keys
'For n = 0 To UBound(a): L = L & a(n) & vbLf: Next
'MsgBox "Les valeurs suivantes sont en doublon :" & vbLf & L, 64, "Attention..."
MsgBox "Ce run existe déjà", 64, "Attention"
End Sub

Il fonctionne parfaitement si je l'associe à un bouton.
Mais mon objectif est une détection auto dès qu'un nouveau numéro est entré dans cette colonne. J'ai donc mis ce code dans la feuille correspondante sous la forme "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
Et là il me détecte un doublon à chaque fois que je clique quelque part même si toute ma colonne B est vide (sauf l'en-tête). je pense qu'il voit toutes les cellules vides comme des doublons mais je n'arrive pas à faire les modifs du code pour que cela ne soit plus le cas.

J'espère que j'ai été assez clair.

Merci d'avance pour votre aide !

 

[Efgé]

Bonjour
Sans exemple, difficile à dire...
Peut-être comme ça :

Sub Doublons_2()
Dim D1, D2, P As Range, C As Range, a()
Set D1 = CreateObject("Scripting.Dictionary")
Set D2 = CreateObject("Scripting.Dictionary")
Set P = Range("B3", [B65000].End(xlUp))

For Each C In P
        If C.Value <> 0 And C.Value <> "" Then D1(C.Value) = D1(C.Value) + 1
        If D1(C.Value) > 1 Then D2(C.Value) = C.Value
Next C
If D2.Count Then
    a = D2.keys
    MsgBox Join(a, ";") & " existe(nt) déjà", 64, "Attention"
End If
End Sub

 

[Efgé]

Re

Comme ça, pour répondre à la question exacte (vérification dès la saisie)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, C As Range

If Intersect(Target, [B:B]) Is Nothing Or Target.Count > 1 Then Exit Sub
Set P = Range("B3", Cells(Rows.Count, 2).End(3))

For Each C In P
    If C.Value <> 0 And C.Value <> "" Then
        If C.Value = Target.Value Then
            MsgBox C.Value & " existe déjà en " & C.Address, 64, "Attention"
            Exit For
        End If
    End If
Next C

End Sub

 

[whiteshark]

Merci de ta réponse aussi rapide!

il n'y a pas vraiment d'exemple je rentre des numéro qui doivent se suivre en colonne B pour faire un suivi et il ne faut pas qu'il y ait 2 fois le même numéro.

Avec le code que tu m'as donné, effectivement il ne me détecte plus de doublons quand je clique n'importe ou sur la feuille, mais maintenant il me met qu'il y a un doublons à chaque fois que j'inscris un chiffre dans la colonne B en me mettant dans le message que le doublons se trouve dans la cellule que je viens justement de remplir, comme si il s'auto-détectait doublon

 

[Exl-Noob]

Salut @whiteshark et le @Efgé,

Pourquoi ne pas remplacer tout simplement par une mise en forme conditionnelle ?

A suivre...

 

[Efgé]

Re
Il faut mettre la

Private Sub Worksheet_Change(ByVal Target As Range)

dans le module de la feuille

 

[whiteshark]

Re
Désolé pour les deux jours sans réponse mais je n'ai pas pu retravailler le fichier vendredi et je n'y ai pas touché du week-end.
Donc j'ai oui j'ai bien fais comme l'exemple que tu m'as donné et le macro est bien au bonne endroit mais il me détecte toujours un doublon à chaque fois que je rentre un valeur en B.
Je t'ai mis le fichier pour que tu puisses voir.

 

[Exl-Noob]

Et avec l'exemple que j'ai adressé avec une mise en forme conditionnelle ? Ca ne fait pas l'affaire ?

 

[Efgé]

Bonjour à tous

Comme quoi avec un exemple dès le début nous aurions gagnés un tour...
Tu utilise un tableau de feuille(et tu as raison).
Donc il faut modifier la plage de vérification :

Set P = Range("B3", Cells(Rows.Count, 2).End(3)(0))

Dans ton cas l'utilisation d'une mise en forme conditionnelle, comme proposée par Exl-Noob, parait une voie à regarder.

Cordialement

 

[whiteshark]

c'est ce que j'avais fait tout au début mais j'ai dû faire une modif sur le fichier et la mise en forme ne correspond plus. Pour faire court cette colonne sert à faire un suivi. En gros à chaque intervention on le note et et en fonction de l'intervention les nombres ne se suivent pas forcément je ne vais pas rentrer dans les détails mais pour savoir à quel numéro on est sans avoir a regarder tout le tableau et repérer le dernier nombre j'ai mis un petit compteur pour savoir exactement ou on en est d'un seul coup d'oeil.
Sauf qu'arrivé aux alentours de 500 on repart à zéro mais ne change pas de fichier parce qu'on en fait 1 par an et la du coup la mise en forme marche plus.

Merci pour vos réponses ! Ta dernière solution Efgé marche parfaitement ! C'est vrai qu'avec l'exemple c'est plus rapide désolé