VBA pour détecter les doublons d'une colonne

[pepsi]

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

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]

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]

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

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

 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]

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

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]

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

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

 

[pepsi]

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

ok, merci pour la précision

 

[CISCO]

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

Bonjour

Cf. en pièce jointe

@ plus

 

[pepsi]

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

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]

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

Bonjour-bonsoir

Essaye avec

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

@ plus

 

[BOISGONTIER]

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]

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

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...

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]

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

bonjour tous
essai de changer

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

  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

 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]

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]

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

changer son numéro ...

 

[pepsi]

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

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

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...]

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

salut

avec un second dico ?

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