Macro beaucoup trop longue

Bonjour,

Je poste ici ma première demande ayant réussi à me débrouiller seul le reste du temps. Je vous explique la situation le plus précisément possible : j'ai une macro qui permet de supprimer des lignes entière en fonction de leurs dates. Cette plage de date est désignée en amont grâce à deux InputBox.

Le code fonctionne parfaitement sauf en terme de temps .. en effet mon fichier contient plusieurs milliers de lignes et la suppression de ces lignes dure plusieurs minutes.

J'ai déjà essayé d'y voir plus clair avec les différents sujets du forum sauf qu'aucun ne ressemble au mien et j'ai du mal à m'y retrouver avec un code différent.

Je vous joins mon code et vous remercie par avance.

Bien à vous,

Nicolas

Sub Gestion_Date()

Worksheets("D_Pointages").Activate

Dim MaDate As Date
Dim MaDate2 As Date
Dim x As Integer
Dim y As Integer

Columns("A:A").Select
Selection.NumberFormat = "m/d/yyyy"
Range("A1").Select

MaDate = InputBox("Quelle date de départ (JJ/MM/AAAA) ?")
For x = Range("A65536").End(xlUp).Row To 2 Step -1
If Range("A" & x) <= MaDate Then Rows(x).Delete
Next

MaDate2 = InputBox("Quelle date de fin (JJ/MM/AAAA) ?")
For y = Range("A65536").End(xlUp).Row To 2 Step -1
If Range("A" & y) > MaDate2 + 1 Then Rows(y).Delete
Next

Worksheets("Tutoriel").Activate

End Sub

bonjour,

sujet traité de nombreuses fois sur le forum.

inspire-toi de ceci. et reviens vers nous si tu n'y arrives pas.

https://forum.excel-pratique.com/viewtopic.php?f=2&t=126812&p=777387#p777387

Bonjour h2so4,

Merci de me mettre sur la bonne voie.

J'ai essayé d'adapter le code que vous m'avez montré cependant il y a des nuances que je n'arrive pas à comprendre ce qui rend mon code faux.

Je me suis aussi renseigné sur la fonction ("Application.ScreenUpdating") mais elle ne permet pas un fonctionnement optimal à elle seule.

Si vous voulez bien m'aider un peu plus profondément, sans forcément me rendre mon code "tout prêt" car j'aime aussi comprendre ce que j'écris, j'en serais ravi.

Bien à vous,

Nicolas

Bonjour,

voici le code adapté à ton cas

Sub Gestion_Date()
    Worksheets("D_Pointages").Activate
    Application.ScreenUpdating = False
    a = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    MaDate1 = CDate(InputBox("Quelle date de départ (JJ/MM/AAAA) ?"))
    MaDate2 = CDate(InputBox("Quelle date de fin (JJ/MM/AAAA) ?"))
    t = Timer()
    For i = LBound(a) To UBound(a)
        If a(i, 1) <= MaDate1 Or a(i, 1) >= MaDate2 Then a(i, 1) = "sup" Else a(i, 1) = 0
    Next i
    Columns("b:b").Insert Shift:=xlToRight
    [B2].Resize(UBound(a)) = a
    [A2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess
    On Error Resume Next
    Range("B2:B65000").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
    Columns("b:b").Delete Shift:=xlToLeft
    MsgBox Timer() - t
    Worksheets("Tutoriel").Activate
End Sub

Merci pour le code fourni.

Cependant j'aurais bien aimé que vous m'expliquiez ce dernier car celui-ci ne supprime que les éléments de la colonne B. Or j'ai besoin des valeurs de plusieurs colonnes et actuellement, ces valeurs sont décalées.

Nicolas

bonjour,

peut-on voir ton fichier ? car je n'ai aucun problème avec le fichier de test que j'ai dû me construire pour t'aider, faute d'avoir reçu le tien.

Bonjour,

Je vous joint le fichier simplifié et sans données importantes.

En B et Q se trouve une suite de nombres.

Après que la macro ce soit réalisée, il y a un problème de référence en B ce qui est normal vu que certaines lignes ont été supprimées.

Cependant en Q la suite de nombre reste intact (comme tout le reste du fichier).

Exemple avant macro :

A---------------------------------------- B-------------------- C

22/05/2019 --------------------- Pierre ---------------------- 1

20/05/2019 --------------------- Walid ----------------------- 2

16/05/2019 --------------------- Mélanie ------------------- 3

01/05/2019 --------------------- Rénald --------------------- 4

Exemple après macro (du 13/05/2019 au 20/05/2019) :

A --------------------------------------- B--------------------- C

20/05/2019--------------------- Walid --------------------- 1

16/05/2019--------------------- Mélanie------------------ 2

Alors qu'initialement, les numéros de Walid et Mélanie étaient respectivement 2 et 3.

J'espère avoir été clair.

Bien à toi,

Nicolas

bonjour,

essaie ceci,

Sub Gestion_Date()
' pour augmenter la vitesse, il faut essayer de supprimer toutes les lignes en un bloc
' donc on repère toutes les lignes à supprimer, on les marque en mettant sup dans une colonne de travail
' on trie le tableau sur cette colonne de travail
' toutes les lignes contenant sup sont groupées
' on supprime en bloc toutes les lignes contenant sup
 'on supprime la colonne de travail

    Application.ScreenUpdating = False
    dl = Cells(Rows.Count, 1).End(xlUp).Row 'nombre de lignes
    dc = Cells(1, Columns.Count).End(xlToLeft).Column 'nombre de colonnes
    a = Range("A2:A" & dl) ' copie colonne de sélection dans tableau A

    MaDate1 = CDate(InputBox("Quelle date de départ (JJ/MM/AAAA) ?")) '1 ere date de l'intervalle à garder
    MaDate2 = CDate(InputBox("Quelle date de fin (JJ/MM/AAAA) ?")) 'dernière date de l'intervalle à garder

    For i = LBound(a) To UBound(a)
        If a(i, 1) <= MaDate1 Or a(i, 1) >= MaDate2 Then a(i, 1) = "sup" Else a(i, 1) = 0 ' on indique sup pour les lignes à supprimer
    Next i

    Columns("b:b").Insert Shift:=xlToRight 'on insère une colonne

    [B2].Resize(UBound(a)) = a 'on y met le tableau a
    Range("A2").Resize(UBound(a), dc).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlNo 'on trie sur cette colonne, => regroupe tous les sup ensemble

    On Error Resume Next

    Range("B2:B" & dl).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete 'suppression en un bloc de toutes les lignes de B, qui contiennent du texte (ici sup)
    Columns("b:b").Delete Shift:=xlToLeft 'suppression de la colonne de selection des lignes

End Sub

Cela fonctionne parfaitement. Cerise sur le gâteau : j'ai les explications en plus!

Merci au forum et surtout à h2so4 pour l'aide apportée.

Bonne journée et bonnes vacances pour les chanceux

Nicolas