Classeur4.xlsx

Bonjour,

Je cherche à supprimer des lignes en doublons. Jusque là c'est "très" simple.
Le problème que je rencontre est que les lignes identifiées en doublons et qui doivent être supprimées sont celles qui n'ont jamais de date(s) renseignée(s) entre les colonnes A et D... je veux par contre conserver les lignes avec des dates.
Avez vous des idées?

ci-joint le fichier sans code.
Ci-après mon code source:

merci de votre aide!!

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Option Explicit
Option Base 1
 
 
Sub SupprimeDoublons()
Dim Plage As Range, Cell As Range
Dim Un As Collection
Dim Tableau() As Long
Dim x As Integer
 
 
Set Un = New Collection
 
Set Plage = Worksheets("Feuil1").Range("E1:E12")
 
For Each Cell In Plage
    On Error Resume Next
    'Alimente la collection de données sans doublons.
    Un.Add Cell, CStr(Cell)
 
    'Une erreur survient si l'élément existe dans la collection.
    'La procédure enregistre le numéro de ligne correspondant dans un tableau.
    If Err.Number <> 0 Then
        x = x + 1
        ReDim Preserve Tableau(x)
        Tableau(x) = Cell.Row
        Cell(x, x).Select
    End If
Next Cell
 
 
'On sort de la procédure s'il n'y a pas de doublons.
If x = 0 Then Exit Sub
 
'Permet de figer l'écran pendant la suppression des lignes.
Application.ScreenUpdating = False
 
'boucle sur le tableau pour supprimer les lignes contenant les doublons.
 
For x = UBound(Tableau) To LBound(Tableau) Step -1
 
        Worksheets("Feuil1").Rows(Tableau(x)).EntireRow.Delete
 
Next x
 
Application.ScreenUpdating = True
MsgBox "Terminé."
 
Set Un = Nothing
End Sub