XL 2019 Suppression date excel VBA

[Lascar22]

Bonjour,
Je viens vers vous car je n'arrive pas à supprimer des dates supérieurs à celle que je fournis, soit le programme me supprime pas les bonnes valeurs, soit il ne me supprime pas les dates avec une année supérieure

Voici mon code :

sub ok()
    Dim der_ligne As Integer
    Dim ligne As Integer
    Dim fin As Date
    
    fin = InputBox("date de fin de l'analyse ? (jj/mm/aaaa)", "Date fin") 'imaginons le 31/05/2022, le tableau contenant des dates allant jusque 2024
    ligne = 1
    der_ligne = Cells(Rows.count,7).End(xlUp).Row
    
    While ligne<der_ligne
        If (cells(ligne, 7).Value > fin) Then
            Rows(ligne).Select
            Selection.Delete Shift:=xlUp
        Else
        End If
        ligne = ligne + 1
    Wend
End Sub

Je vous remercie par avance du temps que vous prendrez pour répondre à ma question.

 

[vgendron]

Bonjour

sans ton fichier exemple, on ne pourra rien pour toi
et en règle générale.. quand on supprime des lignes, il vaut toujours mieux parcourir la feuille en partant du bas vers le haut
dans ton cas
for i=der_ligne to ligne step -1

 

[Lascar22]

Pardon je pensais que le code seul se suffisait

Pourquoi il est préférable de parcourir le tableau à l'envers ?

 

[vgendron]

Essaie avec ce code
j'ai dû modifer ta macro initiale qui travaillait sur la colonne G

on part de la fin pour éviter les décalages d'indice
exemple
si tu fais de 1 jusqu'à 3
si la ligne 2 doit etre supprimée. alors.. la ligne 3 devient la ligne 2.. et du coup. au passage de boucle suivant, la ligne 3 qui est devenue 2 n'est pas traitée..

Sub ok()
    Dim der_ligne As Integer
    Dim ligne As Integer
    Dim fin As Date
    
    fin = InputBox("date de fin de l'analyse ? (jj/mm/aaaa)", "Date fin") 'imaginons le 31/05/2022, le tableau contenant des dates allant jusque 2024
    ligne = 1
    der_ligne = Range("C" & Rows.Count).End(xlUp).Row
    
    For i = der_ligne To ligne Step -1
        If Range("C" & i) > fin Then
            Rows(i).Delete Shift:=xlUp
        End If
    Next i
   
End Sub

 

[Lascar22]

Ça marche super bien ! merci beaucoup pour votre rapidité
Bonne journée à vous