Optimisation de code

Version imprimable

Bonjour,

J ai le code ci dessous qui marche tres bien mais qui est tres tres long (>30000 lignes). Auriez vous une solution d'optimisation ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub Lookup()
 
 NumRow = Worksheets("Blotter").Cells(Worksheets("Blotter").Rows.Count, "B").End(xlUp).Row
 
With Sheets("Blotter")
For i = 2 To 1653 'NumRow
 
.Range("AD" & i).Formula = Application.VLookup(.Range("C" & i), Worksheets("Transco").Range("A:G"), 2, 0)
.Range("AE" & i) = Application.VLookup(.Range("C" & i), Worksheets("Transco").Range("A:G"), 3, 0)
.Range("AF" & i) = Application.VLookup(.Range("C" & i), Worksheets("Transco").Range("A:G"), 4, 0)
.Range("AG" & i) = Application.VLookup(.Range("C" & i), Worksheets("Transco").Range("A:G"), 5, 0)
.Range("AH" & i) = Application.VLookup(.Range("G" & i), Worksheets("Rates").Range("A:C"), 3, 0)
.Range("AI" & i) = .Range("H" & i).Value / .Range("AH" & i).Value
 
Next i
End With
End Sub

Merci d'avance,

Romain

Bonsoir,

Pour améliorer le temps, passer par des variables tableau
Ci-dessous, un essai, si mes lignes sont fausses ce sera faute d'exemple sous les yeux mais le principe est là, je ne peux pas tester évidemment la vitesse

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 Lookup()
Dim NumRow, BLo, TRa, RaT, i As Long, j As Long
  With Worksheets("Blotter")
    NumRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    BLo = Range("A2", "AI" & NumRow)
  End With
  With Worksheets("Transco")
    NumRow = .Range("A" & .Rows.Count).End(xlUp).Row
    TRa = .Range("A2", "G" & NumRow)
  End With
  For i = 1 To UBound(BLo, 1)
    For j = 1 To UBound(TRa, 1)
      If BLo(i, 3) = TRa(j, 1) Then BLo(i, 30) = TRa(j, 2)
      If BLo(i, 3) = TRa(j, 1) Then BLo(i, 31) = TRa(j, 3)
      If BLo(i, 3) = TRa(j, 1) Then BLo(i, 32) = TRa(j, 4)
      If BLo(i, 3) = TRa(j, 1) Then BLo(i, 33) = TRa(j, 5)
    Next j
  Next i
  With Worksheets("Rates")
    NumRow = .Range("A" & .Rows.Count).End(xlUp).Row
    RaT = .Range("A2", "C" & NumRow)
  End With
  For i = 1 To UBound(BLo, 1)
    For j = 1 To UBound(RaT, 1)
      If BLo(i, 7) = RaT(j, 1) Then BLo(i, 34) = RaT(j, 3)
      Exit For
    Next j
    BLo(i, 35) = BLo(i, 8) / BLo(i, 34)
  Next i
  Sheets("Blotter").Range("A2").Resize(UBound(BLo, 1), UBound(BLo, 2)) = BLo
End Sub

Merci pour votre reponse.

En utilisant votre code j'obtiens une pop up out of memory des le debut du code.
J ai tente de me server d array pour une partie de mon code, mais la encore cela a mis environ 20 min pour 150 000 lignes :-(

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 Lookup2()
 
Application.ScreenUpdating = False
 NumRow = Worksheets("Blotter").Cells(Worksheets("Blotter").Rows.Count, "B").End(xlUp).Row
Numrow1 = Worksheets("Transco").Cells(Worksheets("Transco").Rows.Count, "B").End(xlUp).Row
 
Dim a() As Variant
ReDim a(NumRow - 1, 3)
 
Dim toto As Double
'With Sheets("Blotter")
For i = 2 To NumRow
 
'Sheets("Blotter").Range("AD" & i) = Application.WorksheetFunction.VLookup(Sheets("Blotter").Range("C" & i), Worksheets("Transco").Range("A:E"), 2, 0)
Set TATA = Sheets("Transco").Range("A1:A" & Numrow1).Find(Sheets("Blotter").Range("C" & i).Value, LookIn:=xlValues)
a(i - 2, 0) = Sheets("Transco").Range("B" & TATA.Row).Value
a(i - 2, 1) = Sheets("Transco").Range("C" & TATA.Row).Value
a(i - 2, 2) = Sheets("Transco").Range("D" & TATA.Row).Value
a(i - 2, 3) = Sheets("Transco").Range("E" & TATA.Row).Value
 
'.Range("AH" & i) = Application.VLookup(.Range("G" & i), Worksheets("Rates").Range("A:C"), 3, 0)
'.Range("AI" & i) = .Range("H" & i).Value / .Range("AH" & i).Value
 
Next i
'End With
 
Sheets("Blotter").Range("AD2:AG1001") = a()
 
 
Application.ScreenUpdating = True
 
End Sub

Bonjour,

Empêche le calcul en début de proc (mise en manuel) et rétabli en fin (automatique) :

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
 
Sub Lookup()
 
    Dim NumRow As Long
    Dim I As Long
 
    Application.Calculation = xlCalculationManual
 
    With Sheets("Blotter")
 
        NumRow = .Cells(Worksheets("Blotter").Rows.Count, "B").End(xlUp).Row
 
        For I = 2 To 1653 'NumRow
 
            .Range("AD" & I).Formula = Application.VLookup(.Range("C" & I), Worksheets("Transco").Range("A:G"), 2, 0)
            .Range("AE" & I) = Application.VLookup(.Range("C" & I), Worksheets("Transco").Range("A:G"), 3, 0)
            .Range("AF" & I) = Application.VLookup(.Range("C" & I), Worksheets("Transco").Range("A:G"), 4, 0)
            .Range("AG" & I) = Application.VLookup(.Range("C" & I), Worksheets("Transco").Range("A:G"), 5, 0)
            .Range("AH" & I) = Application.VLookup(.Range("G" & I), Worksheets("Rates").Range("A:C"), 3, 0)
            .Range("AI" & I) = .Range("H" & I).Value / .Range("AH" & I).Value
 
        Next I
 
    End With
 
    Application.Calculation = xlCalculationAutomatic
 
End Sub

30/06/2016, 10h59
thebenoit59

Bonjour tout le monde.

Pourrais-tu joindre un exemple de fichier ?
30/06/2016, 11h38
FFGUY

Bonjour,

Helas je ne peux pas uploader le fichier car les donnees confidentielles.
J ai fini par metre mon Vlookup en formule dans la premiere ligne et etendre la formule a l'ensemble du fichier :-( C est pas terrible mais au niveau performance c'est le plus rapide.

Merci pour votre aide,

Romain