Discussion :

[adamgg]

Bonjour,

J'utilise actuellement un code qui me permet de "selectionner" les lignes de mon tableau situes entre 2 dates. je rentre dans des textbox les 2 dates de mon choix et mon programme supprime toute les lignes qui ne sont pas compris entre c'est deux dates.
Comme je travaille sur de grand tableau le temps de suppression est execivement long. J'aimerais donc optimiser ce programme.

voici mon code actuel:

+

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
Private Sub CommandButton1_Click()
Dim D1 As Long
Dim D2 As Long
Dim EndNolig As Long
Dim Nolig As Long
Dim D1Lig As Long
Dim D2Lig As Long
Dim compt As Boolean
Dim j As Long
Dim i As Long
 
compt = 0
D1 = UserForm1.TextBox1.Value
D2 = UserForm1.TextBox2.Value
 
EndNolig = Worksheets("TED Defects 501").Range("A" & Rows.Count).End(xlUp).Row + 2
Nolig = EndNolig
For Nolig = EndNolig To 3 Step -1
 
    If Worksheets("Do not Alter 501").Cells(Nolig, 4).Value = D1 Then
        D1Lig = Nolig
    End If
    If Worksheets("Do not Alter 501").Cells(Nolig, 4).Value = D2 And compt = 0 Then
        D2Lig = Nolig
        compt = 1
    End If
    Nolig = Nolig - 1
Next
 
For j = EndNolig To D2Lig + 1 Step -1
    Worksheets("Do not Alter 501").Cells(j, 1).EntireRow.Delete Shift:=xlUp
 
Next
For i = D1Lig - 1 To 3 Step -1
    Worksheets("Do not Alter 501").Cells(i, 1).EntireRow.Delete Shift:=xlUp
Next
UserForm1.Hide
End Sub

J'ai pense a faire un copier coller de la zone que je souhaite garder est-ce une bonne idee?
Avez vous d'autre idees ?
merci
Adam

[illight]

J'avais un problème comme ça à l'époque aussi, et pour la suppression je faisais la même chose. Jusqu'à que je trouve une méthode plus rapide. j'ai pas le code sous la main, mais je peux t'expliquer le fonctionnement, qu'il faudra que tu mettes en pratique.

En gros, le procédé était de faire un tri, tout d'abord de mes données sur les dates.
Ensuite, étant données que les données étaient triées, il fallait que je trouve la ligne de ma première date.
Une fois ce numéro en ma possession, je cherchais aussi la dernière ligne avec ma date de fin.

Une fois ces 2 données, je supprimer, non pas les ligne une par une, mais par bloc ce qui m'a énormément fait gagné du temps

Finalement, et rapidement, ton code donnerait ça, après tri :

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
 
'recherche de la ligne du début
For Nolig = 2 To range("D10000").end(xlup).row
    If Worksheets("Do not Alter 501").Cells(Nolig, 4).Value = D1 Then
        D1Lig = Nolig
       exit for
    End If
Next
'recherche de la ligne de fin
For Nolig = range("D10000").end(xlup).row To 2 step -1
    If Worksheets("Do not Alter 501").Cells(Nolig, 4).Value = D2 Then
        D2Lig = Nolig
        Exit For
    End If
Next
'on supprime les blocs, en commencant par le dernier bloc (sinon, ton D1Lig voudra plus rien dire...)
Worksheets("Do not Alter 501").Rows(D2Lig +1 & ":" & range("D10000").end(xlup).row).delete Shift:=xlUp
Worksheets("Do not Alter 501").Rows("2:" & D1Lig -1).delete Shift:=xlUp

je t'avoue que je suis plus sur de l'écriture de supprimer d'une ligne, mais c'est pour te donner une idée

[Marc-L]

Bonjour,

commencer par désactiver l'affichage en début de procédure via la propriété ScreenUpdating (cf aide VBA intégrée) …

Si des cellules contiennent des formules de calcul, désactiver aussi le calcul automatique via la propriété Calculation.
Ne pas oublier de réactiver cette dernière avant la fin de la procédure …

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[adamgg]

@ illight
Merci je vois l'idee je vais essayer de la mettre en pratique !

@ Marc-L
Comme mon application tourne sur plusieurs page dois-je desactiver ces deux fonctions sur toute les pages ?
Merci pour l'idee

[Marc-L]

en début de procédure …

Avant les boucles …

[adamgg]

Avant les boucles …

Encore merci