Re : Une histoire de doublons...
Ce code remonte 1 par 1 les adresses des doublons :
Sub Doublons()
' Affiche des messages en indiquant l'adresse cellule des doublons trouvés.
Dim Col As Integer
Dim r As Long
Dim c As Range
Dim N As Long
Dim V As Variant
Dim x As String
Dim Rng As Range
Dim voirdoublons As String
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
N = 0
For r = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(r, 1).Value
x = Rng.Cells(r, 1).Address(0, 0)
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
'Rng.Rows(r).EntireRow.Delete
MsgBox "doublons trouvé(s) : " & "Valeur: " _
& V & Chr(13) & "dans la cellule : " & x
N = N + 1
End If
Next r
EndMacro:
End Sub
****
celui ci les marque en rouge :
Sub Macro_Doublon()
On Error GoTo fin
' Dans une sélection de cellule, met en rouge les cellules contenant des doublons
Set MonDico = CreateObject("Scripting.Dictionary")
Rep1 = InputBox("", "Qelle colonne est à contrôler ?")
If Rep1 = Cancel Then
Exit Sub
Else:
Colon$ = Rep1 ' <<<<<<<<<< colorer les doublons en colonne au choix !?
NoPremLig = 1 ' prem ligne
NoDernLig = Cells(Rows.Count, Colon$).End(xlUp).Row ' dern ligne
' boucle
For NoLig = NoPremLig To NoDernLig
If Cells(NoLig, Colon$) <> "" Then
Var$ = Cells(NoLig, Colon$)
If Not MonDico.Exists(Var$) Then ' ajoute
MonDico.Add Var$, Var$
Else ' sinon existe déjà
Cells(NoLig, Colon$).Interior.ColorIndex = 3 'soit rouge, le 4 = vert clair, etc.
End If
End If
Next
End If
' sélection des cellules contenant des données :
Range(Rep1 & 1 & ":" & Rep1 & NoDernLig).Select
fin:
End Sub