Bonjour à tous,
Ci-joint un fichier sur lequel j'ai travaillé avec l'aide d'un membre d'un autre forum.
Document Cjoint
Le code ci-dessous (en module 5) est très lent (j'ai plus de 6000 lignes à traiter)
Si certains d'entre vous ont une idée pour accélérer ce code je suis preneur.
J'ai lu sur un autre forum :
"le truc, c'est de passer par un tableau. Tu définis toute la zone sur laquelle tu va travailler et tu la mets dans un Range. Tu définis ensuite un Variant et tu mets le Range dedans. Tu travailles sur le Variant, il n'y a plus d'accès à la feuille et ça va 10 fois plus vite. A la fin tu remets le Variant dans le Range d'un seul coup."
Exemple
Dim rg As Range
Dim v as Variant
Set rg = Worksheets("MaFeuille").Range("A1:G10000")
v = rg
'On travaille sur v ...
rg = v
Vous pensez que je peux utiliser cette méthode dans mon code? Je ne la comprends pas trop.
Mon code que j'essaie d'améliorer :
Merci d'avance pour vos conseils.
Ci-joint un fichier sur lequel j'ai travaillé avec l'aide d'un membre d'un autre forum.
Document Cjoint
Le code ci-dessous (en module 5) est très lent (j'ai plus de 6000 lignes à traiter)
Si certains d'entre vous ont une idée pour accélérer ce code je suis preneur.
J'ai lu sur un autre forum :
"le truc, c'est de passer par un tableau. Tu définis toute la zone sur laquelle tu va travailler et tu la mets dans un Range. Tu définis ensuite un Variant et tu mets le Range dedans. Tu travailles sur le Variant, il n'y a plus d'accès à la feuille et ça va 10 fois plus vite. A la fin tu remets le Variant dans le Range d'un seul coup."
Exemple
Dim rg As Range
Dim v as Variant
Set rg = Worksheets("MaFeuille").Range("A1:G10000")
v = rg
'On travaille sur v ...
rg = v
Vous pensez que je peux utiliser cette méthode dans mon code? Je ne la comprends pas trop.
Mon code que j'essaie d'améliorer :
Merci d'avance pour vos conseils.
Code:
Sub Actu()
Dim DLig As Long
Dim i As Long
Dim f As Long
Dim ID As Long
Dim Trouve As Object, PlageDeRecherche As Range
Dim sngChrono As Single
sngChrono = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set PlageDeRecherche = Sheets("Feuil1").Columns(1)
For f = 2 To Worksheets.Count
With Sheets(f)
DLig = .Range("A" & Rows.Count).End(xlUp).Row
DCol = .Cells(10, Columns.Count).End(xlToLeft).Column
For i = 11 To DLig
ID = .Range("A" & i).Value
Set Trouve = PlageDeRecherche.Find(what:=ID, LookAt:=xlWhole)
If Not Trouve Is Nothing Then
therow = Trouve.Row
.Range(.Cells(i, 17), .Cells(i, DCol)).Copy Destination:=Sheets("Feuil1").Range("Q" & therow)
Else
MsgBox ID & " ID Number Not found"
End If
Next i
End With
Next f
Application.ScreenUpdating = True
sngChrono = Timer - sngChrono
MsgBox "Temps d'execution du code en sec : " & CStr(sngChrono)
End Sub