Sub SupprDoublonSupN()
Const Nsuppr = 12
Dim Mondico, ColonB, ColonD
Dim i As Long, MaxLig As Long, S As String, MaxSupp As Long, T1
T1 = Timer
Application.ScreenUpdating = False
Set Mondico = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
MaxLig = .Cells(Rows.Count, "B").End(xlUp).Row
i = .Cells(Rows.Count, "D").End(xlUp).Row
If i > MaxLig Then MaxLig = i
ColonB = Range(.Cells(1, "B"), .Cells(MaxLig, "B")).Value
ColonD = Range(.Cells(1, "D"), .Cells(MaxLig, "D")).Value
End With
With Sheets("Feuil2")
.Range("A:X").Clear
For i = 1 To MaxLig
'Traitement suivant les valeurs Vides ou non des colonnes B ou D
If ColonB(i, 1) = "" And ColonD(i, 1) = "" Then
' colonB et ColonD sont toutes les deux vides => on efface la ligne
' => on ne copie pas la ligne => on ne fait rien
ElseIf ColonB(i, 1) = "" Then
' seule ColonB est vide => on copie la ligne dans tous les cas
MaxSupp = MaxSupp + 1
Sheets("Feuil1").Range(Cells(i, "A"), Cells(i, "X")).Copy _
Destination:=.Range(.Cells(MaxSupp, "A"), .Cells(MaxSupp, "X"))
ElseIf ColonD(i, 1) = "" Then
' seule ColonD est vide => on garde la ligne dans tous les cas
MaxSupp = MaxSupp + 1
Sheets("Feuil1").Range(Cells(i, "A"), Cells(i, "X")).Copy _
Destination:=.Range(.Cells(MaxSupp, "A"), .Cells(MaxSupp, "X"))
Else
' les deux colonnes sont différentes de vide => on copie si doublon < Nsuppr (12)
S = "/" & ColonB(i, 1) & "//" & ColonD(i, 1) & "/"
' Si le couple ( équivalent à S) existe déjà, on lui rajoute +1 dans dico sinon on le crée avec la valeur 1
If Mondico.Exists(S) Then Mondico(S) = Mondico(S) + 1 Else Mondico.Add S, 1
' on vérifie si l'occurence de S est inférieure à Nsuppr (12) ou non. Si oui => on copie la ligne
If Mondico(S) < Nsuppr Then
MaxSupp = MaxSupp + 1
Sheets("Feuil1").Range(Cells(i, "A"), Cells(i, "X")).Copy _
Destination:=.Range(.Cells(MaxSupp, "A"), .Cells(MaxSupp, "X"))
End If
End If
Next i
.Activate
End With
Application.ScreenUpdating = True
MsgBox Format(Timer - T1, "0.00 s")
End Sub