Macro trop lente
Salut les amis
j'ai préparé cette macro à l'aide des experts de ce forum pour m'aider à importer des des données à partir des fichiers externe pour les exploiter dans mes statistiques , mais en la modifiant pour l'adapter à mon classeur j'ai remarqué qu'elle est trop lente elle prend des minutes pour traiter 4 ou 6 classeurs tandis que je dois traiter quelques fois plus de 60 classeurs , meme en l’essayant sur d'autres PC plus puissant c'est la même chose
voila la macro si vous pouvez la rectifier merci
Sub importer()
Sheets("Notescc").Activate
Range("D1:Z15000").ClearContents
Application.ScreenUpdating = False
Dim Fich As String, Sh As Worksheet, i As Long, L As Long, CD As Range
Dim Wbk As Workbook, Coll, K As Long
Set Sh = ThisWorkbook.Sheets("Notescc")
Coll = Application.GetOpenFilename(, , , , True)
For K = 1 To UBound(Coll)
Fich = Coll(K)
Set Wbk = Workbooks.Open(Fich)
For i = 1 To K
L = (i - 1) * 100 + 1
Next i
With Wbk.Sheets("Notescc")
Set CD = .Range("D1:Z100")
Sh.Cells(L, 4).Resize(100, 23).Value = CD.Value
Wbk.Close False
End With
Next K
End Sub
j'ai préparé cette macro à l'aide des experts de ce forum pour m'aider à importer des des données à partir des fichiers externe pour les exploiter dans mes statistiques , mais en la modifiant pour l'adapter à mon classeur j'ai remarqué qu'elle est trop lente elle prend des minutes pour traiter 4 ou 6 classeurs tandis que je dois traiter quelques fois plus de 60 classeurs , meme en l’essayant sur d'autres PC plus puissant c'est la même chose
voila la macro si vous pouvez la rectifier merci
Sub importer()
Sheets("Notescc").Activate
Range("D1:Z15000").ClearContents
Application.ScreenUpdating = False
Dim Fich As String, Sh As Worksheet, i As Long, L As Long, CD As Range
Dim Wbk As Workbook, Coll, K As Long
Set Sh = ThisWorkbook.Sheets("Notescc")
Coll = Application.GetOpenFilename(, , , , True)
For K = 1 To UBound(Coll)
Fich = Coll(K)
Set Wbk = Workbooks.Open(Fich)
For i = 1 To K
L = (i - 1) * 100 + 1
Next i
With Wbk.Sheets("Notescc")
Set CD = .Range("D1:Z100")
Sh.Cells(L, 4).Resize(100, 23).Value = CD.Value
Wbk.Close False
End With
Next K
End Sub
Configuration: Windows / Chrome 71.0.3578.98
2 réponses
-
Bonjour,
Tu ne pourra pas gagner beaucoup de temps,
RemplacesFor i = 1 To K L = (i - 1) * 100 + 1 Next i
parL = (K - 1) * 100 + 1
AjoutesApplication.Calculation = xlCalculationManual
après la ligneApplication.ScreenUpdating = False
EtApplication.Calculation = xlCalculationAutomatic
avant End Sub
-
Salut Patrice33740
j'ai ajouté les modification que vous m'avez proposé , le temps de l’exécution de la macro a diminué de plus de la moitié , mais elle encore lente surtout pendant : Range("D1:Z15000").ClearContents et avant sa fermeture-
Essaies:
Sub importer() Dim Wbk As Workbook, Sh As Worksheet, CD As Range Dim Coll, Fich As String, K As Long, L As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set Sh = ThisWorkbook.Sheets("Notescc") Sh.Range("D1:Z15000").ClearContents Coll = Application.GetOpenFilename(, , , , True) For K = 1 To UBound(Coll) Fich = Coll(K) Set Wbk = Workbooks.Open(Fich) L = (K - 1) * 100 + 1 Set CD = Wbk.Sheets("Notescc").Range("D1:Z100") Sh.Cells(L, 4).Resize(100, 23).Value = CD.Value Wbk.Close False Next K Sh.Activate Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End SubCe serait peut-être plus rapide en récupérant les infos sans ouvrir les fichiers, mais c'est pas sûr. -
-
-
@Patrice33740Ok merci infiniment
-
