Re : [macros] suppression doublon et comparaison
Bonjour,
Suppression de doublons rapide (1sec pour 10.000 lignes et 80% suppression):
Sub SupRapide1CritereColonneA()
t = Timer()
Application.ScreenUpdating = False
[A1].Sort Key1:=Range("A2"), Order1:=xlAscending, _
Header:=xlGuess
Columns("b:b").Insert Shift:=xlToRight
[B1] = "ColB"
[B2].FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],1,0)"
[B2].AutoFill Destination:=Range("B2:B" & [A65000].End(xlUp).Row)
[B:B].Value = [B:B].Value
[A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
[B:B].Replace What:="1", Replacement:="", LookAt:=xlPart
Range("B2:B65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("b:b").Delete Shift:=xlToLeft
MsgBox Timer() - t
End Sub
Sub SupRapide2CriteresColAetB()
t = Timer()
Application.ScreenUpdating = False
[A1].Sort Key1:=Range("A2"), Order1:=xlAscending, _
Key2:=Range("B2"), Order2:=xlAscending, _
Header:=xlGuess
Columns("b:b").Insert Shift:=xlToRight
[B1] = "ColB"
'[B2].FormulaR1C1 = "=IF(RC[-1]=R[-1]C[-1],1,0)"
[B2].FormulaR1C1 = "=IF(AND(RC[-1]=R[-1]C[-1],RC[+1]=R[-1]C[+1]),1,0)"
[B2].AutoFill Destination:=Range("B2:B" & [A65000].End(xlUp).Row)
[B:B].Value = [B:B].Value
[A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
[B:B].Replace What:="1", Replacement:="", LookAt:=xlPart
Range("B2:B65000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("b:b").Delete Shift:=xlToLeft
MsgBox Timer() - t
End Sub
Bisson