Bonjour,
Je suis nouvelle sur ce forum, et j'ai un pb équivalent à celui de cette discussion.
Voici le contexte :
J'ai un code vba dans une base access, qui compare des data d'un fichier excel et de la database, les tries et export le tout dans un fichier excel puis pdf.
J'ai fait plusieurs macros liées les unes aux autres et l'un d'entre elle dure plus d'1 min et un autre 9 min !! Je cherche à optimiser le code afin de réduire ce temps de process.
Pourriez-vous m'aider ?
Ci-dessous quelques infos. Merci d'avance pour votre aide.
Diane
Le bout de code ci-dessous est pour la macro d'1 min: cette macro consiste à chercher les valeurs dans une plage de données de tous les onglets d'un fichier excel (jusqu'à 9 onglets - 2430 valeurs) et les coller dans une colonne dans un autre fichier ("strFilename").
Le second bout de code ci-dessous (9 min) consiste à comparer et supprimer parmi les 2430 valeurs collées précédemment à celles initialement dans le fichier strFilename (64 valeurs max).
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 For Each Freezer In ActiveWorkbook.Worksheets Set Plage = Freezer.Range("C5:L63") 'Boucle For Each Cell In Plage If Cell.Value <> Empty Then If Cell.Value <> "Rack ID" Then 'Copie les valeurs du freezer interface Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Value = Cell.Value 'copie les couleurs Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Interior.Color = Cell.Interior.Color 'copie le nom du freezer Workbooks(strFilename).Worksheets(1).Range("A" & LinB).Value = Freezer.Name LinB = LinB + 1 Else End If End If Next Next End With
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 derlig = Workbooks(strFilename).Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row For i = 2 To derlig FindString = Workbooks(strFilename).Worksheets(1).Range("B" & i).Value If Trim(FindString) <> "" Then With Sheets(1).Range("E2:E65") Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Rng Is Nothing Then Sheets(1).Range("A" & i).Delete Shift:=xlUp Sheets(1).Range("B" & i).Delete Shift:=xlUp i = i - 1 Else Sheets(1).Range("C" & Rng.Row).Copy Sheets(1).Range("F" & i).PasteSpecial xlPasteAll Sheets(1).Range("D" & Rng.Row).Copy Sheets(1).Range("G" & i).PasteSpecial xlPasteAll End If End With End If Next
Partager