1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
| Sub test()
Dim i As Long, j As Long, x As String
Application.ScreenUpdating = False
With Sheets(1) '<-- nom ou position de la feuille à adapter
For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
x = .Cells(i, 1) & .Cells(i, 2) & .Cells(i, 3)
For j = i - 1 To 1 Step -1
If .Cells(j, 1) & .Cells(j, 2) & .Cells(j, 3) = x Then
If .Cells(j, 4) < .Cells(i, 4) Then
.Rows(j).Delete
Else
.Rows(i).Delete
Exit For
End If
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub |
Partager