Recherche de doublons dans une colonne

Dudulle32
Messages postés
42
Date d'inscription
mercredi 10 mai 2006
Statut
Membre
Dernière intervention
31 janvier 2014
- 31 janv. 2014 à 16:27
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
- 31 janv. 2014 à 17:44
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.

2 réponses

ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
Modifié par ucfoutu le 31/01/2014 à 17:15
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 ?
0
ucfoutu
Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
235
31 janv. 2014 à 17:44
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 If
End Sub

0