Recherche de doublons dans une colonne

Question

Bonjour, 
 
Je travaille actuellement sur une petite application sur Excel pour référencer des chargements.
Dans une colonne je note les n° de bons de chargement, logiquement chaque n° est unique.

Il arrive parfois qu'un chargement soit enregistré 2 fois par erreur, aussi dans un bu de vérification je voudrais détecter des doublons dans cette colonne (colonne B, avec une entête sur la 1ere ligne).

Voici mon code que j'ai adapté d'une source trouvée sur le net ; j'avoue que je ne le comprend pas tout à fait...

  [B:B].Interior.ColorIndex = xlNone  Set mondico = CreateObject("Scripting.Dictionary")  For Each c In Range("b2", [b65000].End(xlUp))    If c <> "" Then mondico.Item(c.Value) = mondico.Item(c.Value) + 1  Next c  For Each c In Range("b2", [b65000].End(xlUp))    If mondico.Item(c.Value) > 1 Then c.Interior.ColorIndex = 3  Next c
 

Le code s'exécute, mais il ne se passe rien, les cellules contenant un doublon ne changent pas de couleurs.

Savez vous où se situe mon erreur ?

En vous remerciant d'avance.

ucfoutu · Answer

Bonjour,
Et pourquoi fais-tu (puisque ce n'est que pour colorier) les frais de ce dictionnaire inutilement alourdissant ?
regarde ce que t'offre VBA tout seul ===>>
derlig = Range("B" & Rows.Count).End(xlUp).Row For i = derlig To 3 Step -1   If WorksheetFunction.CountIf(Range("B3:B" & i), Range("B" & i).Text) > 1 Then     Range("B" & i).Interior.ColorIndex = 3   End If Next

PS : et à quoi cela te sert-il vraiment de ne faire que les colorier ?

ucfoutu · Answer

Je dois m'absenter.
Je me "projette" alors déjà, pour le cas où tu voudrais en fait les supprimer ensuite :
regarde ce que fait ce bouton placé sur la feuille de calcul
Private Sub CommandButton1_Click()  Dim doublons As Range, derlig As Long, i As Long  derlig = Range("B" & Rows.Count).End(xlUp).Row  For i = derlig To 3 Step -1    If WorksheetFunction.CountIf(Range("B3:B" & i), Range("B" & i).Text) > 1 Then      If doublons Is Nothing Then        Set doublons = Range("B" & i)      Else        Set doublons = Application.Union(doublons, Range("B" & i))      End If    End If  Next  If Not doublons Is Nothing Then   doublons.Interior.ColorIndex = 3 ' ==>> si tu tiens vraiment à les colorier   If MsgBox("voulez-vous supprimer ces doublons (cellules " & _   doublons.Address & ") ?", vbYesNo + vbCritical) = vbYes Then ' ===>> si tu tiens à ce message     doublons.EntireRow.Delete   End If ' ===>>> si tu tiens à ce message End IfEnd Sub

Recherche de doublons dans une colonne

2 réponses

Votre réponse

Discussions similaires