Programme de recherche temps d'execution trop long

**lucas67** · 19/11/2007, 11h52

Bonjour,

J'effectue une mise en arborescence d'une nomenclature. Pour cela j'utilise plusieurs boucles pour rechercher les sous composants.
Mon problème est que j'ai 29 équipements et plus de 7000 sous équipements mon programme va chercher pour chaque équipement son sous équipement, pour chaque sous équipement son sous sous équipement, etc....
Il ya donc un grand nombre de tests dans mon programme dont le temps d'exucution est trés trés long...
Est-qu'il y aurait une possibilité d'optimiser mon programme pour qu'il soit plus rapide car je débute et je m'y suis peut-être mal pris.

Mon programme est en pièce jointe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
Dim Wbks_Modele As Workbook
Dim Gr As Integer, Current_Ligne As Integer
Dim Valeur_reference As Integer
 
 
Public Sub Arborescence()
'---------------------------------------------------------------------------------------------------------------------------------------------------
'déclaration des variables'
'---------------------------------------------------------------------------------------------------------------------------------------------------
Dim i As Integer, Ref_Equip As Variant, Equipement_Ligne As Integer
Dim j As Integer, iTempDebut As Integer, iTempFin As Integer, NewGroup As Integer, Temp1 As Variant, Temp2 As Variant
Dim C As Integer
 
Dim Reference As String
Dim cellX, cellY As Integer
 
Current_Ligne = 2
 
Set Wbks_Modele = Workbooks.Open("C:\Modele.xls")
Wbks_Modele.Activate
 
'--------------------------------------------------------------------------------------------------------------------------------------------------
'Inscription de la première ligne de la feuille Arboresence et mise en page de cette feuille
'--------------------------------------------------------------------------------------------------------------------------------------------------
Worksheets("Arborescence").Cells(1, 1) = "Repère"
Worksheets("Arborescence").Cells(1, 9) = "Désignation des sous équipements"
Worksheets("Arborescence").Cells(1, 17) = "Référence désignation"
Worksheets("Arborescence").Cells(1, 18) = "Indice désignation"
Worksheets("Arborescence").Cells(1, 19) = "Code tra"
Worksheets("Arborescence").Cells(1, 20) = "COEF"
Worksheets("Arborescence").Cells(1, 21) = "UM"
Worksheets("Arborescence").Cells(1, 22) = "Référence plan"
Worksheets("Arborescence").Cells(1, 23) = "Indice Plan"
Worksheets("Arborescence").Cells(1, 24) = "Code CTRL"
 
 
Worksheets("Arborescence").Range("A1:P1").ColumnWidth = 4
Worksheets("Arborescence").Range("R1:U1").ColumnWidth = 4
Worksheets("Arborescence").Range("W1:X1").ColumnWidth = 4
 
'-------------------------------------------------------------------------------------------------------------------------------------------------
'Fonction groupement'
'-------------------------------------------------------------------------------------------------------------------------------------------------
 
For i = 2 To 29
    'Copie de la première ligne'
    Gr = 0
    Worksheets("Nomenclature ele").Cells(i, 1).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 1)
    Worksheets("Nomenclature ele").Cells(i, 4).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 9)
    Worksheets("Nomenclature ele").Cells(i, 3).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 17)
    Worksheets("Nomenclature ele").Cells(i, 2).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 18)
    Worksheets("Nomenclature ele").Cells(i, 6).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 19)
    Worksheets("Nomenclature ele").Cells(i, 7).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 20)
    Worksheets("Nomenclature ele").Cells(i, 5).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 22)
    Worksheets("Nomenclature ele").Cells(i, 2).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 23)
 
    Worksheets("Arborescence").Rows(Current_Ligne).Interior.Color = RGB(255, 255, 0)
    Application.CutCopyMode = False
    Current_Ligne = Current_Ligne + 1
    Equipement_Ligne = Current_Ligne - 1
 
    'Recherche de la référence'
    Ref_Equip = Worksheets("Nomenclature ele").Cells(i, 3).Value
    For Each cellule In Worksheets("Nomenclature PF").Range("A1:A8000")
        If cellule.Value = Ref_Equip Then
            Gr = 2
            'Copie du repère
            Worksheets("Nomenclature PF").Cells(cellule.Row, 4).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, Gr)
            If Gr < 7 Then
                For R = Gr + 1 To 7
                    Worksheets("Arborescence").Cells(Current_Ligne, R).Value = "'-"
                Next
            End If
            'Copie désignation
            Worksheets("Nomenclature PF").Cells(cellule.Row, 7).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, Gr + 8)
            'Copie de la référence de désignation
            Worksheets("Nomenclature PF").Cells(cellule.Row, 5).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 17)
            'Copie de l'indice de désignation
            Worksheets("Nomenclature PF").Cells(cellule.Row, 2).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 18)
            'Copie du code trac.'
            Worksheets("Nomenclature PF").Cells(cellule.Row, 6).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 19)
            'Copie de UM
            Worksheets("Nomenclature PF").Cells(cellule.Row, 12).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 21)
            'Copie du COEF
            Worksheets("Nomenclature PF").Cells(cellule.Row, 11).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 20)
            'Copie de la référence du plan
            Worksheets("Nomenclature PF").Cells(cellule.Row, 8).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 22)
            'Copie de l'indice du plan
            Worksheets("Nomenclature PF").Cells(cellule.Row, 9).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 23)
            'Copie du code CTRL
            Worksheets("Nomenclature PF").Cells(cellule.Row, 13).Copy
            ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 24)
 
            Application.CutCopyMode = False
            Current_Ligne = Current_Ligne + 1
            Gr = Gr + 1
            If Gr < 7 And Ref_Equip <> "" Then
 
                cellX = Current_Ligne - 1
                cellY = 17
 
                Reference = Worksheets("Arborescence").Cells(cellX, cellY).Value
 
                Fct_Search_And_Place (Reference)
 
            End If
        End If
    Next
Next
Fct_Groupement_SousEquipements (Current_Ligne)
End Sub

Merci d'avance

**ouskel'n'or** · 19/11/2007, 12h05

Déjà tu peux simplifier ton code en mettant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim FL1 as worksheet
Set FL1 = Wbks_Modele.worksheets("Arborescence")
Dim FL2 as worksheet
Set FL2 = Wbks_Modele.worksheets("Nomenclature ele")
'puis
    FL1.Cells(1, 1) = "Repère"
    FL1.Cells(1, 9) = "Désignation des sous équipements"
'puis, pour la copie
    FL2.Cells(i, 1).Copy  FL1.Cells(Current_Ligne, 1)

C'est déjà plus court
Enfin, en début de macro, ajoute

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.screenUpDating = False

Et en en sortie de macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.screenUpDating = True

Après tu nous dis déjà ce que ça donne

**lucas67** · 19/11/2007, 16h00

Salut,

Merci grâce à tes conseils mon code est plus lisible et s'execute un peu plus vite, toutefois le temps d'execution est encore trés long.
Aurais-tu d'autres astuces ? Peut-être qu'il faut agire aux niveaux des boucles ? (méthode de dichotomie,...)

**House MD** · 19/11/2007, 16h01

Tu peux également remplacer tes méthode For Each / If / Then par la méthode : If Not Iserror / Find

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'Cette Ligne uniquement si tu n'es pas sur de rencontrer "Blabla" :
If Not iserror(Application.match("Blabla",range(cells(2,1),cells(X,Y)),0)) then
'Cette ligne trouve instantanément la ligne ou est pérsente ta variable
B=range(cells(1,1),cells(X,Y)).find(what:="Blabla",lookat:=xlwhole).row

Mais tu peux également faire des recherches en colonnes...

Attention, en ligne, commencer par une ligne plus haut sans quoi si ton élément se trouve dans la première cellule, il ne la verra pas...

Remarque : tu peux remplacer lookat:=xlpart si tu recherche une sous-partie d'une chaine de caractères (auquel cas tu écriras :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Not iserror(Application.match("*Blabla*"...

dans ta première ligne

Ces 2 méthodes sont d'une rapidité redoutable...

**patbou** · 19/11/2007, 18h52

bonjour,
le copier/coller est lui aussi tres long .
si tu n as pas besoin du format des cells affecte directement les valeurs
un peu du style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
dim fl1 as worksheet
dim fl2 as worksheet
set fl1 = .....
set fl2 = .....
fl1.cells(i,j).value = fl2.cells(k,l).value

**ouskel'n'or** · 19/11/2007, 19h03

Pour la recherche dichotomique, regardee là http://www.developpez.net/forums/sho...d.php?t=444075
A+

**alsimbad** · 19/11/2007, 19h16

également, tu peux remplacer tes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 Worksheets("Nomenclature ele").Cells(i, 1).Copy
    ActiveSheet.Paste Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 1)

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Worksheets("Nomenclature ele").Cells(i, 1).Copy Destination:=Worksheets("Arborescence").Cells(Current_Ligne, 1)

**lucas67** · 21/11/2007, 15h15

Merci !
Grâce à tous vos conseils le temps d'execution de mon programme est trés court.
Encore merci à vous tous.

a +

Programme de recherche temps d'execution trop long

Macros et VBA Excel

Discussions similaires

Partager

Partager