VBA pour détecter les doublons d'une colonne

pepsi · 5 Avril 2016

Bonjour le forum

j'ai récupéré un code qui permet de détecter les doublons d'une colonne
le problème c'est qu 'il considère le 0 comme un doublon, et j'aimerai éviter cela

comment puis je modifie le code?

merci d'avance

Code:

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

pepsi · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Ton code marche bien : il n'est plus sensible à la casse.
si'l pouvait passer en rouge la première occurrence du doublon ca serait top

pepsi · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

CISCO à dit:
Bonjour

Le plus simple serait d'utiliser une mise en forme conditionnelle, non ?

@ plus

tu m'as donné un piste effectivement

mais le code considère tous les cellules ayant une valeur nulle en doublon

Code:

 Columns("A:A").Select
    Selection.FormatConditions.AddUniqueValues
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).DupeUnique = xlDuplicate
    With Selection.FormatConditions(1).Font
        .Color = -52429
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
  
End Sub

pepsi · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

thebenoit59 à dit:

Code:

Sub Doublon()
    Dim Plage As Range
    Dim Cel As Variant
 
Set Plage = Worksheets("Feuil1").Range("a2:a" & [a65000].End(xlUp).Row)
Set d = CreateObject("Scripting.Dictionary"): Set d2 = CreateObject("Scripting.Dictionary")

   For Each Cel In Plage
        If Cel.Value <> 0 And d.exists(Ucase(Cel.Value)) Then
            Cel.Interior.ColorIndex = 3: d2(Cel.Address) = Cel.Value
                Else: d(Ucase(Cel.Value)) = ""
        End If
    Next Cel
    
    For Each Cel In d2.Keys
        m = m & Chr(10) & d2(Cel) & " en " & Cel
    Next Cel
    
MsgBox "Les valeurs suivantes sont en doublons, les supprimer manuellement" & m, vbCritical
End Sub

Dis-moi si ça fonctionne.

On ne peut pas passer la première occurrence en rouge car elle n'est pas considérée comme un doublon, c'est pour ça ?

thebenoit59 · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Avec ce code, effectivement on ne peut pas le faire comme ça.

pepsi · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

ok, merci pour la précision

CISCO · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Bonjour

Cf. en pièce jointe

@ plus

pepsi · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

CISCO à dit:
Bonjour

Cf. en pièce jointe

@ plus

Merci,

effectivement, il considère 0 comme un doublon quand des 0 sont saisis....

l'idéal il faudrait qu'il ne soit pas considéré

CISCO · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Bonjour-bonsoir

Essaye avec

Code:

=(A1<>0)*(A1<>"")*((NB.SI(A$1:A1;A1)>1)+(NB.SI(A1:A$32;A1)>1))

@ plus

BOISGONTIER · 5 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Bonjour,

Repérer les groupes de doublons avec des couleurs différentes

http://boisgontierjacques.free.fr/fichiers/Cellules/ColorGroupe.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/GroupBoublons3.xls

Repérage des doublons

JB

pepsi · 6 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

BOISGONTIER à dit:
Bonjour,

Repérer les groupes de doublons avec des couleurs différentes

http://boisgontierjacques.free.fr/fichiers/Cellules/ColorGroupe.xls
http://boisgontierjacques.free.fr/fichiers/Cellules/GroupBoublons3.xls

Repérage des doublons

JB

j'essaye d'adapter le code que tu as proposé, en essayer d'afficher un message signalant les doublons reperés.

voilà ma modification qui ne fonctionne pas...

Code:

Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In Range("a2", [a65000].End(xlUp))
   If C.Value <> 0 Then
    mondico.Item(C.Value) = mondico.Item(C.Value) + 1
    End If
  Next C
  For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.Item(C.Value) > 1 Then C.Interior.ColorIndex = 3
  Next C
 
    
    For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.Item(C.Value).exist Then
     m = m & Chr(10) & mondico(C)
       
            End If
        
          Next C
    
MsgBox "Les valeurs suivantes sont en doublons, les supprimer manuellement" & m, vbCritical
    
    End
    
End Sub

laetitia90 · 6 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

bonjour tous

essai de changer

Code:

For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.Item(C.Value).exist Then
     m = m & Chr(10) & mondico(C)
       
            End If
        
          Next C

par

Code:

  For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.exists(C.Value) Then m = m & Chr(10) & mondico(C)
    Next C

comme cela c'est mieux

Code:

 For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.exists(C.Value) Then m = m & Chr(10) & mondico.Item(C)
    Next C

CPk · 6 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Bonjour le fil...Pardon mais...Pepsi...Dans votre process de travail, si vous avez un doublon vous devez faire quoi ?

pepsi · 7 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

changer son numéro ...

pepsi · 7 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

Le message box ne me renvoie pas du tout les doublons...

Code:

Sub ColoriageDoublons()
  [A:A].Interior.ColorIndex = xlNone
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each C In Range("a2", [a65000].End(xlUp))
   If C.Value <> 0 Then
    mondico.Item(C.Value) = mondico.Item(C.Value) + 1
    End If
  Next C
  For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.Item(C.Value) > 1 Then C.Interior.ColorIndex = 3
  Next C

For Each C In Range("a2", [a65000].End(xlUp))
    If mondico.exists(C.Value) Then m = m & Chr(10) & mondico.Item(C.Value)
    Next C

    
MsgBox "Les valeurs suivantes sont en doublons, les supprimer manuellement" & m, vbCritical
    
    End
    
End Sub

Si... · 7 Avril 2016

Re : VBA pour détecter les doublons d'une colonne

salut

avec un second dico ?

Code:

Sub ColoriageDoublons()
  Dim D1, D2, P As Range, C As Range, a(), n As Long, L As String
  [A:A].Interior.ColorIndex = xlNone
  Set D1 = CreateObject("Scripting.Dictionary")
  Set P = Range("A2", [A65000].End(xlUp))
  For Each C In P
   If C.Value <> 0 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..."
End Sub

VBA pour détecter les doublons d'une colonne

pepsi

XLDnaute Occasionnel

pepsi

XLDnaute Occasionnel

pepsi

XLDnaute Occasionnel

pepsi

XLDnaute Occasionnel

thebenoit59

XLDnaute Accro

pepsi

XLDnaute Occasionnel

CISCO

XLDnaute Barbatruc

Pièces jointes

pepsi

XLDnaute Occasionnel

CISCO

XLDnaute Barbatruc

BOISGONTIER

XLDnaute Barbatruc

pepsi

XLDnaute Occasionnel

laetitia90

XLDnaute Barbatruc

CPk

XLDnaute Impliqué

pepsi

XLDnaute Occasionnel

pepsi

XLDnaute Occasionnel

Si...

XLDnaute Barbatruc

Discussions similaires