Macro trop lente
noe2008
Messages postés
184
Date d'inscription
Statut
Membre
Dernière intervention
-
noe2008 Messages postés 184 Date d'inscription Statut Membre Dernière intervention -
noe2008 Messages postés 184 Date d'inscription Statut Membre Dernière intervention -
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
A voir également:
- Macro trop lente
- Pc trop lent - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Mon pc est trop lent et se bloque - Guide
2 réponses
Bonjour,
Tu ne pourra pas gagner beaucoup de temps,
Remplaces
Ajoutes
Et
Tu ne pourra pas gagner beaucoup de temps,
Remplaces
For i = 1 To K L = (i - 1) * 100 + 1 Next ipar
L = (K - 1) * 100 + 1
Ajoutes
Application.Calculation = xlCalculationManualaprès la ligne
Application.ScreenUpdating = False
Et
Application.Calculation = xlCalculationAutomaticavant 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
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.