Bonjour à la communauté,

Je vous écris car je rencontre des lenteurs lors du lancement ma macro pour effectuer une serie de 8 vlookup afin de mettre à jour un fichier Excel Central.

Il s'agit de deux fichiers, entreposé dans le même folder.
Les données sont centralisées dans le fichier "Central" avec comme nom de feuille excel "Master".
L'ensemble des vlookup collectent les informations du deuxième fichier Excel qui se nomme "Updated_data" sous la feuille excel "General".

J'ai réduis ici le nombre de vlookup à 2 pour éviter d'avoir un code à ralonge.

Il faut environ 17 minutes pour compléter dans le fichier central.

Auriez-vous une solution pour diminuer le timing ?

Merci d'avance

Cordialement

Code : 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
43
44
45
46
47
 
Sub vlookup()
Dim ws_1 As Worksheet
Dim work_book As Workbook
Dim work_sheet As Worksheet
Dim search_statut As Variant
Dim search_type As Variant
 
Set ws_1 = Worksheets("MASTER")
Set work_book = Workbooks("Updated_data.xlsx")
Set work_sheet = work_book.Sheets("General")
 
'Statut
On Error Resume Next
search_statut_racine = Application.WorksheetFunction.VLookup(ws_1.Range("C3:AD10000"), _
work_sheet.Range("H3:AD10000"), 2, False)
 
On Error GoTo 0
If (IsEmpty(search_statut_racine)) Then
ws_1.Range("O2:O10000").Formula = CVErr(xlErrNA)
Else
ws_1.Range("O2:O10000").Value = search_statut_racine
End If
 
'Statut type
On Error Resume Next
search_CMLT = Application.WorksheetFunction.VLookup(ws_1.Range("C3:AD10000"), _
work_sheet.Range("H3:AD10000"), 18, False)
 
On Error GoTo 0
If (IsEmpty(search_CMLT)) Then
ws_1.Range("Y2:Y10000").Formula = CVErr(xlErrNA)
Else
ws_1.Range("Y2:Y10000").Value = search_CMLT
End If
 
Columns("O:O").Select
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
 
Columns("Y:Y").Select
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
 
End Sub