Améliorer vitesse de calcul d'une macro simple
Bonjour,
J'ai un système de gestion qui gère l'ensemble de l'activité. Je n'ai pas vraiment de problème, tout fonctionne correctement.
En revanche je suis à la recherche d'efficacité et de rapidité.
Sur une de mes fonctionnalités, j'effectue un calcul de temps de service.
Ci dessous le code:
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 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
|
Private Sub Generate_Click()
Dim FC As Worksheet
Dim DT As Worksheet
Dim FP As Workbook
Dim ML As Worksheet
Dim FD As Workbook
Dim dat As Worksheet
Dim l As Variant
Dim c As Variant
Dim d As Variant
Dim li As Long
Dim r As Long
Dim cn As Variant
Dim tri As Variant
Dim ro As Long
Dim lig As Long
Dim mln As Variant
Dim nam As Variant
Dim col As Long
Set FC = Sheets("flight control")
Set DT = Sheets("data fdp")
c = FC.Range("E5").Value
l = FC.Range("A49:A5000").End(xlUp).Row + 1
For r = DT.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
If FC.Range("E5") = DT.Range("A" & r) Then
FC.Range("A" & l) = DT.Range("A" & r)
FC.Range("B" & l) = DT.Range("B" & r)
FC.Range("C" & l) = DT.Range("C" & r)
FC.Range("D" & l) = DT.Range("D" & r)
FC.Range("E" & l) = DT.Range("E" & r)
FC.Range("F" & l) = DT.Range("F" & r)
FC.Range("G" & l) = DT.Range("G" & r)
FC.Range("H" & l) = DT.Range("H" & r)
FC.Range("I" & l) = DT.Range("I" & r)
l = l + 1
End If
Next r
tri = FC.Range("E5").Value
Set cn = Range("O3:O100").Find(tri)
ro = cn.Row
FC.Range("D3") = FC.Range("M" & ro).Value
Set FD = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "flight data.xlsm")
Set nam = Workbooks("Flight data").Sheets("data").Range("BX3:BX50").Find(FC.Range("E5"))
col = nam.Row
Set dat = Sheets("data")
If dat.Range("BX" & col).Value = FC.Range("E5") Then
FC.Range("C27") = dat.Range("BZ" & col).Value
FC.Range("C28") = dat.Range("CA" & col).Value
FC.Range("H28") = dat.Range("BY" & col).Value
FC.Range("E20") = dat.Range("CD" & col).Value
FC.Range("B20") = dat.Range("CF" & col).Value
End If
FD.Close savechanges:=True
End Sub |
La ligne 34 fait que le calcul est long, car parcourant toutes les lignes à la recherche de la condition. Pour moi ce temps est acceptable, il faut compter 5 secondes, mais pour les opérateurs qui ils trouvent que cela est un peu long.
J'ai donc essayé de modifier le code comme suit:
Code:
1 2
|
For r = DT.Range("A1:A5000").End(xlUp).Row To 1 Step -1 |
Cela a très bien fonctionné, ils sont devenus contents car le calcul était pratiquement instantané...et pour cause cela ne calcul pas.
Ma question est donc la suivante: quelle méthode permettrait de remplacer cette ligne permettant de gagner en performance sans pour autant tout réécrire? Ce n'est pas que je ne veux pas refaire mais j'estime que quand une solution fonctionne, c'est bien d'améliorer mais il ne faut pas que le temps gagné d'un côté soit perdu de l'autre, sachant que cela n'est pas mon métier de faire du code.
Merci de votre retour et bonne journée.