[XL-2003] Supprimer une ligne sous condition de date [Résolu]

[fortbelin]

Bonjour à tous et à toutes.

J'ai besoin de votre aide pour une macro.

Il s'agit de pouvoir supprimer des lignes d'une feuille excel mais seulement si une cellule de cette ligne contiens une date qui est antérieure à une date de référence.

Donc par exemple, supprimer toutes les lignes qui contiennent des dates antérieur au 25/12/2002

Merci beaucoup pour votre aide

[Daniel.C]

Le code suivant n'est pas le plus couurt mais je pense qu'il est performant :

Code :

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
    Dim c As Range, Plage As Range
    With Sheets("Feuil1").UsedRange
    '"Plage" est l'ensemble des cellules non vides
    On Error Resume Next
    Set Plage = .SpecialCells(xlCellTypeConstants, xlNumbers)
    If Err.Number <> 0 Then
        Set Plage = .SpecialCells(xlCellTypeFormulas, xlNumbers)
        Err.Clear
    Else
        Set Plage = Union(Plage, .SpecialCells(xlCellTypeFormulas, xlNumbers))
    End If
    On Error GoTo 0
    End With
    With Plage.Areas(Plage.Areas.Count)
        ' de la dernière ligne à la première ligne de Plage
        For i = .Row + .Rows.Count - 1 To Plage.Areas(1).Row Step -1
            If Not Intersect(Plage, Rows(i)) Is Nothing Then
                'boucle sur les ellules de Plage
                For Each c In Intersect(Plage, Rows(i))
                    'si la condition est remplie
                    If IsDate(c) And c.Value < #12/25/2002# Then
                        If c.Value < #12/25/2002# Then
                            Rows(i).Delete
                            Exit For
                        End If
                    End If
                Next c
            End If
        Next i
    End With

[mercatog]

Une proposition sans boucle (à adapter) en utilisant un filtre automatique et en supprimant les lignes résultat du filtre:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Test()
Dim LastLig As Long
Dim MaDate As Date
 
Application.ScreenUpdating = False
MaDate = DateSerial(2002, 12, 25)
With Worksheets("Feuil1")                                  'ADAPTE LE NOM DE TA FEUILLE
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "D").End(xlUp).Row       'JE SUPPOSE QUE TES DATES SONT EN COLONNE D ET QU'EN D1 TU AS LE TITRE DE TA COLONNE
    .Range("D1").AutoFilter Field:=1, Criteria1:="<=" & CLng(MaDate)
    If .Range("D1:D" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("D2:D" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    .AutoFilterMode = False
End With
End Sub