Marquer les doublons par paire

**Cercle** · 07/10/2008, 11h27

Bonjour,

J'utilise le code suivant pour marquer les doublons d'une colonne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub MarqueLesDoublons()
Dim Plage As Range, i&, Cell As Range, Rng As Range
 
On Error Resume Next
Set Plage = Application.InputBox("Plage à examiner", Type:=8)
If IsEmpty(Plage) Then Exit Sub
 
Application.ScreenUpdating = False
 
For Each Cell In Plage
For i = 1 To Plage.Count
Set Rng = Cell.Offset(i)
If Rng <> "" And Rng = Cell Then
Cell.Interior.ColorIndex = 43
Rng.Interior.ColorIndex = 43
Exit For
End If
Next i
Next Cell
 
End Sub

Seulement, j'aimerais marquer les doublons par paire, soit chaque fois qu'il y a au moins deux cellules identiques.

Exemple :

2 cellules avec le chiffe 10, j'en marque 2
3 cellules avec le chiffe 10, j'en marque 2
4 cellules avec le chiffe 10, j'en marque 4
5 cellules avec le chiffe 10, j'en marque 4
etc

Merci d'avance de votre aide