Optimiser une macro VBA

Version imprimable

Bonjour,

J'aimerais optimiser la macro suivantes qui marche trés bien mais qui prend un peu de temps.

Est-ce qu'il est possible d'optimiser la macro pour qu'elle aille plus vite

Cdt,

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
Sub Indice()
 
Sheets("loyer").Select
 
Dim A, N, P, M, Indice
 
  For L = 2 To Sheets("suivi").Range("A1").CurrentRegion.Rows.Count
  For c = 15 To 70
 
  N = Sheets("suivi").Cells(L, 11)
  P = Sheets("suivi").Cells(1, c)
  M = Sheets("suivi").Cells(L, 12)
 
    A = Sheets("indice").Range("a4:a2872").Resize(, 3)
  For i = 1 To UBound(A, 1)
 
    If A(i, 1) = N And A(i, 2) = P And A(i, 3) = M Then
 
Indice = Sheets("indice").Range("d4:d2872")(i).Value
 
Sheets("loyer").Cells(L, c).FormulaLocal = Indice
 
    End If
 
  Next i
 
  Next c
 
  Next L
 
End Sub

19/07/2011, 16h02
dodo69
Bonjour momo,

Déjà ajoute au début de ta macro ( après le sub)

Code:

Application.ScreenUpdating=False

et juste avant la fin:

Code:

Application.ScreenUpdating= True

Après tu peux remplacer :
Code:

1 2 3 N = Sheets("suivi").Cells(L, 11) P = Sheets("suivi").Cells(1, c) M = Sheets("suivi").Cells(L, 12)
Par
Code:

1 2 3 4 5 With sheets("suivi") N = .Cells(L, 11) P = .Cells(1, c) M = .Cells(L, 12) End With
Après s'il explore toutes ces cellules, c'est normal que ca prenne du temps,

C'est tout ce que je peux te dire, les pro pourront certainement l'améliorer d'avantages...

Cdlt
DoDo

Sans fichier difficile d'adapter. mais quand même une supposition (qui risque fort de ne pas fonctionner faute de ton fichier)

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
Sub Indice()
Dim L As Long, LastLig As Long, i As Long
Dim A, Tb, Res() As String
Dim N As String, M As String, P As String
Dim C As Integer
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
A = Sheets("indice").Range("A4:D2872")
With Sheets("suivi")
    LastLig = .Range("A1").CurrentRegion.Rows.Count
    Tb = .Range("A1").CurrentRegion
End With
ReDim Res(1 To LastLig - 1, 1 To 56)
For L = 2 To LastLig
    N = Tb(L, 11)
    M = Tb(L, 12)
    For C = 15 To 70
        P = Tb(1, C)
        For i = 1 To UBound(A, 1)
            If A(i, 1) = N And A(i, 2) = P And A(i, 3) = M Then Res(L - 1, C - 14) = A(i, 4)
        Next i
    Next C
Next L
Sheets("loyer").Cells(2, 15).Resize(LastLig - 1, 56) = Res
Application.Calculation = xlCalculationAutomatic
End Sub

19/07/2011, 16h46
momo93240

merci à tous les 2

J'ai testé les 2 methodes et j'ai gagné 15 secondes avec la premieres methodes en revanche la seconde est un peu plus longue

Bien à vous,