Re : Dédoublonnage impossible à optimiser
Bonjour
pour optimiser la vitesse de traitement
mettre en début de macro ce code
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
et en fin de macro
Application.Calculation = xlCalculationautomatic
ci dessous du code à adapter
Sub Deleteif_findwordtrue()
'destruction selective de lignes contenant une occurence
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Quoi As String, Rng As Range, Frange As Range, C As Object, Lastrow&
Quoi = "TEST"
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = ActiveSheet.Range("A1:A" & Lastrow)
If Application.CountIf(Rng, Quoi) > 0 Then
For Each C In Rng
If UCase(C.Value) = Quoi Then
If Frange Is Nothing Then
'Set Frange = C.EntireRow
Set Frange = C(1, 1)
Else
' Frange= la plage des objets trouvés
' Set Frange = Union(Frange, C.EntireRow)
Set Frange = Union(Frange, C(1, 1))
End If
End If
Next
If Not Frange Is Nothing Then
Frange.Interior.ColorIndex = 36
Frange.Replace What:=Quoi, Replacement:="Ici", LookAt _
:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
'ou encore Frange.Delete
Set Frange = Nothing
End If
End If
Cordialement
Flyonets