Microsoft 365 Suppression ligne en fonction de la date

ivan27

XLDnaute Occasionnel
Bonsoir à tous,
En VBA, je souhaite supprimer les lignes d'une liste sous condition.
Je souhaite conserver uniquement les lignes dont la date est immédiatement inférieure à la date du jour.
Dans l'exemple en pièce jointe, si je demande la suppression aujourd'hui 22/02, je souhaite conserver les lignes du 20/02 uniquement.
Merci d'avance pour votre aide.
Bien cordialement,
 

Pièces jointes

  • Suppression ligne.xlsx
    11.8 KB · Affichages: 3
Solution
Bonsoir Ivan,
Un essai en PJ avec :
VB:
Sub Nettoie()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row                  ' Dernière ligne
    T = Range("A2:A" & DL)                              ' Transfert plage dans array
    For i = UBound(T) To 1 Step -1                      ' Trouver la date immédiatement inférieure à aujourd'hui
        If T(i, 1) < Date Then
            MaDate = CLng(T(i, 1))                      ' Bonne date trouvée
            Exit For
        End If
    Next i
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion colonne en A
    f = "=SI(B2<>" & MaDate & ";CAR(1);0)"              ' Formule utilisée. Attention ajouter 1 aux colonnes pour compenser...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Ivan,
Un essai en PJ avec :
VB:
Sub Nettoie()
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row                  ' Dernière ligne
    T = Range("A2:A" & DL)                              ' Transfert plage dans array
    For i = UBound(T) To 1 Step -1                      ' Trouver la date immédiatement inférieure à aujourd'hui
        If T(i, 1) < Date Then
            MaDate = CLng(T(i, 1))                      ' Bonne date trouvée
            Exit For
        End If
    Next i
    Columns("A:A").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion colonne en A
    f = "=SI(B2<>" & MaDate & ";CAR(1);0)"              ' Formule utilisée. Attention ajouter 1 aux colonnes pour compenser nouvelle colonne en A.
    With Range("A2:A" & DL)                             ' Plage où coller la formule en colonne A qui sera triée
        .FormulaLocal = f                               ' Coller formule
        .EntireRow.Sort .Cells, xlDescending            ' Tri pour regrouper et accélérer
        .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete  ' Suppression des lignes concernées
    End With
    [A:A].Delete Shift:=xlToLeft                        ' Effacement colonne formules
    Columns.AutoFit                                     'Ajustement largeurs colonnes
    With ActiveSheet.UsedRange: End With                'Ajustement barres de défilement
End Sub
 

Pièces jointes

  • Suppression ligne (2).xlsm
    23.7 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
314 633
Messages
2 111 403
Membres
111 123
dernier inscrit
lauTTTTTTTTT