[XL-2010] optimisation code vba

optimisation code vba

Bonjour tous le monde,

A l'aide,

Je dois rendre un travail la semaine prochaine.

En effet, je boucle sur plus de 95565 lignes, avec bien entendu des calculs entre temps.

Mon problème est que mon code n'est pas optimisé.
Je vous mets le code, si vous pouvez m'aidez

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
Sub correspondance_abc_passage_LSCO()
Application.ScreenUpdating = False
 
  'filtre données base abc sur scolaire pour diminuer le nombre de lignes sur lesquelles boucler.
  Call remonte_sco_abc
  Call remonte_sco_passage
 
l = Sheets("abc").Range("A3").End(xlDown).Row
 Sheets("abc").Range("AA3:AA" & l).ClearContents
array1 = Sheets("abc").Range("G3:AA" & l).Value
ll = Sheets("passage").Range("A4").End(xlDown).Row
array2 = Sheets("passage").Range("P4:Q" & ll).Value
 
 For i = LBound(array1) To UBound(array1)
   'condtion pour continuer le traitement c'est à dire il faut avoir du scolaire
  If array1(i, 1) = "SCOLAIRE" Then
    j = 1
     Do
      If array1(i, 20) = array2(j, 1) Then
         array1(i, 21) = "trouvee"
      Exit Do
      End If
      j = j + 1
    Loop Until array2(j, 2) <> "SCOLAIRE"
    If array1(i, 21) <> "trouvee" Then
        array1(i, 21) = "non trouvee"
    End If
 Else
 Exit For
 End If
 Next
 ' à la sortie ici j'aura fini les scolaires.
Sheets("abc").Range("G3:AA" & l).Value = array1
'j 'appel ensuite la fonction qui permet de faire le même traitement pour les lignes régulières.
Call correspondance_abc_passage_LREG
Application.ScreenUpdating = True
End Sub

Ci joint également le code correspondant à correspondance_abc_passage_LREG

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
Sub correspondance_abc_passage_LREG()
Application.ScreenUpdating = False
 
  'filtre données base abc sur scolaire pour aller plus vite
  Call remonte_reg_abc
  Call remonte_reg_passage
l = Sheets("abc").Range("A3").End(xlDown).Row
array1 = Sheets("abc").Range("G3:AA" & l).Value
ll = Sheets("passage").Range("A4").End(xlDown).Row
array2 = Sheets("passage").Range("P4:Q" & ll).Value
 
 For i = LBound(array1) To UBound(array1)
   'condtion pour continuer le traitement c'est à dire il faut avoir du scolaire
 
  If array1(i, 1) = "LIGNE REG" Then
    j = 1
     Do
      If array1(i, 20) = array2(j, 1) Then
         array1(i, 21) = "trouvee"
      Exit Do
      End If
      j = j + 1
    Loop Until array2(j, 2) <> "LIGNE REG"
    If array1(i, 21) <> "trouvee" Then
        array1(i, 21) = "non trouvee"
    End If
 Else
 Exit For
 End If
 Next
Sheets("abc").Range("G3:AA" & l).Value = array1
Application.ScreenUpdating = True
End Sub

Je vous remercie d'avance pour votre aide.
BARRY

Salut, à essayer, mais le gain risque d'être minime

Code:

1
2
3
4
5
6
7
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
'.....
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

Bonjour,

un aperçu de tes procédures "remonte_xxx" me semble également necessaire

j'ai bien l'impression que tu as écris des tonnes de procédures pour chaque cas, plutôt que de rédiger quelques procédures dont les arguments permettent de généraliser chaque cas.

optimisation vba

Bonsoir à tous

Merci pour vos réactions.

Je joint du coup les données via ce lien, il y a également un onglet qui explique ce qui est attendu.

Sinon pouvez vous me dire à quelle procédures généralisables pensez au vu du code que j'ai fourni précedemment?

En vous remerciant d'avance.

BARRY