Bonjour à tous,

J'ai dans un même fichier deux feuilles à mettre en relation pour ce faire j'ai voulu effectuer un vlookup en vba. Mon problème étant la lenteur d'exécution de ma macro je remonte de la feuille1 (~600lignes) deux colonnes dans la feuille2 (~14000).
J'ai essayé de coder de deux manière différente mais je reste toujours entre 3 & 4min d'exécution. Ci-dessous mes deux tentatives en m'en remettant à votre expertise et en vous remerciant par avance.

Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub vlookup()
Dim i As Long
Dim j As Long
LR1 = Worksheets("POr files").Range("E" & Rows.Count).End(xlUp).Row
LR2 = Worksheets("Doc Buy").Range("A" & Rows.Count).End(xlUp).Row
 
    For j = 7 To LR2
        For i = 2 To LR1
            If Worksheets("Doc Buy").Range("A" & j).Value = Worksheets("POr files").Range("E" & i).Value Then
                  Worksheets("POr files").Range("AG" & i).Value = Worksheets("Doc Buy").Range("J" & j).Value
                  Worksheets("POr files").Range("AH" & i).Value = Worksheets("Doc Buy").Range("R" & j).Value
                 Else
            End If
    Next i
Next j
 
Columns("AA:AA").Replace What:=".", Replacement:=","
For i = 2 To LR1
    If IsNumeric(Range("AA" & i)) = True Then
        Range("AA" & i).Value = Range("AA" & i).Value * 1
    End If
Next i
'environ 2" 6100
End Sub
____________________________________________________________________________
 
Sub vlookup2()
On Error Resume Next
Dim i As Long
Application.ScreenUpdating = False
Table1 = Worksheets("POr files").Range("E2:E6106") ' ID
table2 = Worksheets("Doc Buy").Range("A7:AB706") ' data source
 
i = 2
        For Each cl In Table1
            Worksheets("POr files").Cells(i, 32) = Application.WorksheetFunction.vlookup(cl, table2, 10, False)
            Worksheets("POr files").Cells(i, 33) = Application.WorksheetFunction.vlookup(cl, table2, 18, False)
            i = i + 1
        Next cl
Application.ScreenUpdating = True
'environ 3" 14kl / 1"36 6100
End Sub