code vba pour détecter doublons

Bonjour,

Je recherche à détecter sur ma colonne M (avec une ligne d'en-tête) les valeurs en double.
Quel est le code vba qui me permettrait, à la première valeur en double rencontrée (exemple : citron) de se positionner sur la case de la première des deux valeurs identiques et de faire afficher un message box disant "attention, la valeur citron est en double, veuillez éliminer manuellement le doublon avant de pouvoir exporter les données".

Merci d'avance !

Max

Bonjour,

Une piste. La colonne de recherche est en A :

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
29
30
31
 
Sub Doublon()
 
    Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("Feuil1")
 
    'en colonne "A" à partir de A2
       Set Plage = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
 
    'boucle la plage de la feuille "Compte" et cherche chaque valeur
   'en correspondance exacte dans la plage de la feuille "Source"
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
            MsgBox "Attention, la valeur '" & Cel.Value & "' est en doublon," _
                   & " veuillez éliminer manuellement le double situé en '" & Cel.Address(0, 0) _
                   & "' avant de pouvoir exporter les données !"
 
            Cel.Interior.ColorIndex = 3
 
        End If
 
    Next Cel
 
End Sub

*
Sinon, plus radical, suppression de toutes les lignes en doublons (explications dans le code) :

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
 
Sub Doublons()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim DL As Long
    On Error Resume Next
 
    Application.ScreenUpdating = False
 
    'toute la zone utilisée sur la feuille
    Set Plage = Worksheets("Feuil1").UsedRange
 
    'cellule où coller la plage filtrée
    Set Cel = Worksheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
 
    'filtre sans doublons. Attention seuls les doublons strictement identiques
    'seront supprimés, si une des cellules dans deux lignes qu'ont pense identiques
    'est différente, la ligne n'est pas considérée comme doublon
    Plage.AdvancedFilter xlFilterCopy, , Cel, True
 
    'supprime la page originelle
    Plage.Delete
 
    Application.ScreenUpdating = True
 
End Sub

Hervé.

Bonjour Theze (ça rime avec balèze, il me semble... ;) ),

Ton code est parfait ! :ccool:
En plus c'est sympa les cases qui se colorient :D

Merci donc pour ta précieuse réponse !

Max