Macro RechercheV trop lente

[legenuis]

Bonjour,

j'ai voulu faire des recherchev des reférences contenues d'un fichier sur plusieurs autres (40).

Sauf que rien que sur 2 fichiers la macro met 2 min (trop long). la macro boucle sur 1000 lignes et 15 colonnes.

J'ai récupérer ce code sur le forum et je supçonne ces éléments de ralentir la macro :

Find(.Range("B" & m), LookIn:=xlValues, lookat:=xlWhole)

Voici le code au complet :

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
34
35
36
37
38
39
40
41
42
 
 
Sub A_Total()
Chemin = ThisWorkbook.Path
Fich = Dir(Chemin & "\Pays\*.xls")
Set ws = ThisWorkbook
 
Do While Fich <> ""
  Workbooks.Open (Chemin & "\Pays\" & Fich)
  With ActiveWorkbook.Sheets("FORECAST 2012")
   For m = 10 To .Range("B1000").End(xlUp).Row
 
   'si le statut (colonne A) est nul raye les cellules de la colonne 2 à 31
      If .Range("A" & m) = 0 Then  'verifie si statut=0
        For p = 2 To 31 'colonne 2 à 31
           .Cells(m, p).Font.Strikethrough = True 'raye la cellule
        Next
 
      Else
      'definit "c" comme le resultat de la recherche de la ref dans le fichier source
      Set c = ws.Sheets("VOLUME").Columns("B").Find(.Range("B" & m), LookIn:=xlValues, lookat:=xlWhole)
 
        If Not c Is Nothing Then 'si "c" n'est pas vide c'est à dire que la ref est dans le fichier source
          For p = 15 To 29  'colonne du 1er mois à colonne du dernier mois
            ws.Sheets("VOLUME").Cells(c.Row, p) = ws.Sheets("VOLUME").Cells(m, p) + .Cells(m, p) 'ajoute la qté du pays  pour le mois au total de la ref
          Next p
 
        Else 'la ref n'est pas dans le fichier source
          derlin = ws.Sheets("VOLUME").Range("A1000").End(xlUp).Row + 1 'définit la derniere ligne du gichier source
          For p = 15 To 29 'colonne du 1er mois à colonne du dernier mois
            ws.Sheets("VOLUME").Cells(derlin, p) = .Cells(m, p) 'ajoute la qté du pays pour le mois
          Next p
 
        End If
      End If
   Next m
  End With
  ActiveWorkbook.Close True
    Fich = Dir
Loop
 
End Sub

Fichiers ci-joints.
Merci pour votre aide.

[jfontaine]

Bonjour,

Essais en désactivant les calculs et l'affichage

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
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub A_Total()
Chemin = ThisWorkbook.Path
Fich = Dir(Chemin & "\Pays\*.xls")
Set ws = ThisWorkbook

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Do While Fich <> ""
  Workbooks.Open (Chemin & "\Pays\" & Fich)
  With ActiveWorkbook.Sheets("FORECAST 2012")
   For m = 10 To .Range("B1000").End(xlUp).Row
 
   'si le statut (colonne A) est nul raye les cellules de la colonne 2 à 31
      If .Range("A" & m) = 0 Then  'verifie si statut=0
        For p = 2 To 31 'colonne 2 à 31
           .Cells(m, p).Font.Strikethrough = True 'raye la cellule
        Next
 
      Else
      'definit "c" comme le resultat de la recherche de la ref dans le fichier source
      Set c = ws.Sheets("VOLUME").Columns("B").Find(.Range("B" & m), LookIn:=xlValues, lookat:=xlWhole)
 
        If Not c Is Nothing Then 'si "c" n'est pas vide c'est à dire que la ref est dans le fichier source
          For p = 15 To 29  'colonne du 1er mois à colonne du dernier mois
            ws.Sheets("VOLUME").Cells(c.Row, p) = ws.Sheets("VOLUME").Cells(m, p) + .Cells(m, p) 'ajoute la qté du pays  pour le mois au total de la ref
          Next p
 
        Else 'la ref n'est pas dans le fichier source
          derlin = ws.Sheets("VOLUME").Range("A1000").End(xlUp).Row + 1 'définit la derniere ligne du gichier source
          For p = 15 To 29 'colonne du 1er mois à colonne du dernier mois
            ws.Sheets("VOLUME").Cells(derlin, p) = .Cells(m, p) 'ajoute la qté du pays pour le mois
          Next p
 
        End If
      End If
   Next m
  End With
  ActiveWorkbook.Close True
    Fich = Dir
Loop
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub