Aide pour optimisation/gain de temps sur une macro
Cheres amies, chers amis du forum
Voici un bout de code qui s’exécute via une boucle:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
Workbooks.Open Filename:=strWorksheetPath
strWorksheetName = ActiveWorkbook.Name
With ActiveWorkbook.Worksheets("TEST")
Worksheets("TEST").Activate
.
.
.
gvVNTCriteriaVector = CreateCriteriaVector(dictReference)
'filtre: affichage du complémentaire de l'ensemble des refernces de la peronnes concerné
.Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter Field:=20, Criteria1:=Array(gvVNTCriteriaVector), Operator:=xlFilterValues
'destruction des lignes HS
Call DeleteRow(Nrow, Ncol)
.Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter
'actualisation des TCD et recalcul
Application.Calculate
Workbooks(strWorksheetName).Close True
j = j + 1
End With |
Et le code de la sub DeleteRow
Code:
1
2
3
4
5
6
7
8
9
10
|
Sub DeleteRow(ByVal intRowTabSize As Long, ByVal intColTabSize As Long)
Dim rngRangeRef, rngRangeDel As Range
Set rngRangeRef = ActiveSheet.Range(ActiveSheet.Cells(5, 1), ActiveSheet.Cells(intRowTabSize + 3, intColTabSize + 3))
Set rngRangeDel = rngRangeRef.Resize(ActiveSheet.Range(ActiveSheet.Cells(5, 1), ActiveSheet.Cells(intRowTabSize + 3, intColTabSize + 3)).Rows.Count)
rngRangeDel.SpecialCells(xlCellTypeVisible).Delete shift:=xlUp
End Sub |
Et je trouve que la sélection des valeur du filtre via la commande Array, et la destruction des ligne prennent beaucoup de temps. De plus le recalcule de tout les TCD et autre feuille prend aussi bcp de temps. Dés lors pour la création des fichier pour l’équipe entière (environ 40 personne) cela prend 1H05....Les fichiers creer sont diffrerent pour chacune des personnes, c'est - à - dire que le vecteur gvVNTCriteriaVector est modifier a chaque fois.
A part ce bout de code le reste vas tres vite.
Auriez vous une idée SVP?
Merci
