Accélérer exécution de la macro

boyz

XLDnaute Nouveau
Bonjour,

Je dispose d'une macro (macro 1 située dans le module 2) qui complète mon tableau (B2:J"X") en mettant pour chaque cellule le chemin de la donnée source que je souhaite qui se trouve dans d'autres classeurs. Chaque ligne FORM XXX correspond à un fichier différent.

Ma problématique est que pour 10 lignes ça peut aller mais quand il faut en remplir 100 ça prend environ 3 minutes.

Est-il donc possible d'optimiser l’exécution de ma macro? Je tiens à préciser que j'ai déjà mis "Application.ScreenUpdating = False/true" dans la macro.

Vous trouverez ci-joint mon fichier.

Je me tiens à votre disposition si vous avez des questions.

Je vous remercie par avance.

Boyz
 

Pièces jointes

  • Récap.xlsm
    26.7 KB · Affichages: 49

Efgé

XLDnaute Barbatruc
Re : Accélérer exécution de la macro

Bonjour boyz

Une proposition:
VB:
Sub Macro1b()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
nbcells = Application.WorksheetFunction.CountA(Feuil1.Range("$A:$A")) + 1
For i = 2 To nbcells
    Range("$B$" & i & ":$J" & i).FormulaLocal = "='" & Range("chemin_dossier").Value & "[" & Range("$A" & i).Value & "]" & "Feuil2" & "'!A2"
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Cordialement
 

Dranreb

XLDnaute Barbatruc
Re : Accélérer exécution de la macro

Bonjour.

Essayez comme ça :
VB:
Sub Macro1()
Application.ScreenUpdating = False
Dim DébFml As String, Plg As Range, Te(), Tr(), L&, C&
DébFml = "='" & [chemin_dossier].Value & "["
Set Plg = Application.Range(Feuil1.[Debut].Offset(1), Feuil1.[Debut].Offset(60000).End(xlUp))
Te = Plg.Value
ReDim Tr(1 To UBound(Te), 1 To 9)
For L = 1 To UBound(Te)
   For C = 1 To 9
      Tr(L, C) = DébFml & Te(L, 1) & "]Feuil2'!$" & EntCol(C) & "$2"
      Next C, L
Application.DisplayAlerts = False
Plg.Offset(, 1).Resize(, 9).Value = Tr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function EntCol(ByVal N As Long) As String
Do: N = N - 1: EntCol = Chr$(N Mod 26 + 65) & EntCol: N = N \ 26: Loop Until N = 0
End Function
Function ColEnt(ByVal C As String) As Long
Dim P As Long: For P = 1 To Len(C): ColEnt = ColEnt * 26 + Asc(UCase(Mid$(C, P, 1))) - 64: Next P
End Function
 

Discussions similaires

Réponses
4
Affichages
304

Statistiques des forums

Discussions
312 103
Messages
2 085 319
Membres
102 862
dernier inscrit
Emma35400