Réduire le temps d'exécution

Bonjour tout le monde,
J'ai mis un code VBA pour exploiter un TCD qui s'actualise quand je change la date dans le segment , et dans un tableau à coté via le code VBA je récupère la date filtrée et le nombre de "Numéro" qui ont subit que l'opération "C1".
mon code marche très bien (j'ai même ajouter un code dans la feuille du TCD pour lancer la macro si actualisation :) )sauf qu'il met du temps (dans cet exemple je n'ai pas beaucoup de ligne mais dans le fichier sur lequel je vais appliquer j'ai plusque 100000 lignes...).
Je vous serez reconnaissante si vous me proposer une amélioration à mon code afin que je puisse gagner du temps ;;)

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 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50

Sub nbrop() Application.ScreenUpdating = False Dim i As Integer Dim j As Integer Dim k As Integer Dim L As Integer   Dim compteur As Integer     Dim valdate As Boolean   i = 9 j = 2 k = 9 L = 9 compteur = 0   Sheets("NBR OP").Select   Sheets("NBR OP").Range("J2:J50").Select Sheets("NBR OP").Range("J2:J50").Clear Sheets("NBR OP").Range("K2:K50").Clear     While i < 36 And j < 36   valdate = IsDate(Sheets("NBR OP").Cells(i, 1).Value) If valdate = True Then Sheets("NBR OP").Cells(j, 10) = Sheets("NBR OP").Cells(i, 1).Value L = 9 compteur = 0 While L < 20000 If Sheets("NBR OP").Cells(L, 1).Value = Sheets("NBR OP").Cells(j, 10).Value And Sheets("NBR OP").Cells(L, 2).Value <> "" And Sheets("NBR OP").Cells(L, 3).Value = "" And Sheets("NBR OP").Cells(L, 4).Value = "" Then compteur = compteur + 1   L = L + 1 Wend Sheets("NBR OP").Cells(j, 11) = compteur   i = i + 1 j = j + 1   ElseIf valdate = False Then Exit Sub   End If Wend       End Sub

---

Ci-joint le fichier Excel.

Très bonne journée :) Pièce jointe 401347Pièce jointe 401347

Bonjour

en utilisant une variable tableau

attention le code si dessous est une piste de solution qui se base sur le code initial
ça reste à optimiser

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 31 32 33 34 35 36 37 38 39 40 41

Sub nbropmethode2() Application.ScreenUpdating = False   Dim i As Integer Dim j As Integer Dim k As Integer Dim L As Integer Dim compteur As Integer Dim valdate As Boolean i = 4 j = 2 k = 9 L = 9 compteur = 0 tableau1 = Sheets("NBR OP").Range("A8").CurrentRegion   While i < 36 And j < 36   valdate = IsDate(tableau1(i, 1)) If valdate = True Then Sheets("NBR OP").Cells(j, 10) = tableau1(i, 1) L = 9 compteur = 0 While L < UBound(tableau1, 1) If tableau1(L, 1) = Sheets("NBR OP").Cells(j, 10).Value And tableau1(L, 2) <> "" And tableau1(L, 3) = "" And tableau1(L, 4) = "" Then compteur = compteur + 1   L = L + 1 Wend Sheets("NBR OP").Cells(j, 11) = compteur       i = i + 1 j = j + 1   ElseIf valdate = False Then Exit Sub   End If Wend   End Sub

---

utiliser exitsub me semble une mauvaise idée
je ne comprend pas le "While i < 36 And j < 36"

pour 10 000 lignes sur mon poste

le temps passe de 3 S à 0.34 S