Optimisation code boucle

Version imprimable

22/11/2010, 10h41
Marius76

Optimisation code boucle

Bonjour tout le monde,

J ai mis au point un petit code pour trier une base de donnée plus ou moins grande qui est importé d'access et dont la taille des colonnes différencie suivant la demande.
Je dois ressortir des stats de certaines colonnes.
Par exemple (exemple type que je répète plusieurs fois) : je fouille dans la colonne A de la feuille importée, je regarde le premier élément je compte combien de fois il se trouve dans la colonne, je regarde sur le Feuille Stats si il a deja été enregistré et si non je l ajoute.

Mon code fonctionne parfaitement mais n'étant pas expert j'ai fait avec mes connaissances. Du coup j utilise des boucles et activate Feuille X pour jongler entre les différentes feuilles.

J voulais par conséquent savoir qu elle était le moyen d optimiser tout cela car ca prend un peu de temps et je risque de devenir epileptique d'ici peu (ca jongle entre les différentes feuilles pendant un peu plus de 5 secondes).

Merci par avance.
22/11/2010, 10h48
rvtoulon
bonjour,
pour eviter se scintillement met ceci en début de code :
Code:

1 2 3 4 5 Sub Test () 'Tu déclares tes variables 'et ensuite Application.ScreenUpdating = False 'ici La suite du code
et à la fin du code:
Code:

1 2 3 4 'ton code 'et Application.ScreenUpdating = True End Sub
Maintenant si veux de l'aide sur ton code ce serait bien de le mettre:aie:.
22/11/2010, 10h48
pgz

Bonjour.

TU peux charger dans des tableaux les données de toutes le feuilles utiles et faire tes calculs sans plus accéder aux feuilles.
Les résultats doivent être aussi rangés dans des tableaux.
Une fois que c'est fait tu copies en une fois les résultats dans la feuille concernée.

Cordialement,

PGZ

Code:

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
Sub Bouton1_Clic()
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim Cmpt As Integer
Dim Cmptgeo As Integer
Dim StrBuf As String
Dim StrBufbis As String
Dim Addstage As Integer
Dim AddGeo As Integer
Dim Cmptter As Integer
 
i = 2
j = 2
 
'boucle qui me permet de connaitre le nombre de sociétés avec tous les critères ensuite par colonne
 
Worksheets("Rtest").Activate
Do While Cells(i, 1).Value <> ""
    i = i + 1
Loop
 
Worksheets("Stats").Activate
Cells(3, 4).Value = i - 1
 
'Boucle qui me permet de voir tant que j ai pas atteind la derniere boite de voir si le critère (géographioque par exemple) a deja été ajouté dans les stats géo et si non (cf AddGeo = 1 ou 0) je compte combien de fois je le trouve dans la colonne
 
Do While j < i
 
   AddGeo = 1
   Addstage = 1
   Cmpt = 0
   Cmptgeo = 0
   k = 5
   m = 5
 
   Worksheets("Rtest").Activate
   StrBuf = Cells(j, 2).Value
   StrBufbis = Cells(j, 6).Value
 
   Worksheets("Stats").Activate
 
   Do While (Cells(k, 3).Value <> "" And Addstage = 1)
 
    If StrBuf = Cells(k, 3).Value Then
    Addstage = 0
 
    End If
 
    k = k + 1
    Loop
 
 
    Do While (Cells(m, 10).Value <> "" And AddGeo = 1)
 
    If StrBufbis = Cells(m, 10).Value Then
    AddGeo = 0
 
    End If
 
    m = m + 1
    Loop
 
 
 
    If Addstage = 1 Then
        Worksheets("Rtest").Activate
        For l = 2 To i
        If Cells(l, 2).Value = StrBuf Then
        Cmpt = Cmpt + 1
        End If
        Next
 
        Worksheets("Stats").Activate
        Cells(k, 3).Value = StrBuf
        Cells(k, 4).Value = Cmpt
 
    End If
 
    If AddGeo = 1 Then
        Worksheets("Rtest").Activate
        For l = 2 To i
        If Cells(l, 6).Value = StrBufbis Then
        Cmptgeo = Cmptgeo + 1
        End If
        Next
 
        Worksheets("Stats").Activate
        Cells(m, 10).Value = StrBufbis
        Cells(m, 11).Value = Cmptgeo
 
    End If
 
j = j + 1
 
Loop
 
Cmpt = 0
Cmptbis = 0
Cmptter = 0
 
Worksheets("Rtest").Activate
 
'Autre boucle pour voir les sociétés hors critères.
For l = 1 To i
    If Cells(l, 4) = "Out" Then
    Cmpt = Cmpt + 1
    End If
    If Cells(l, 3) = "Out" Then
    Cmptbis = Cmptbis + 1
    End If
    If Cells(l, 5) = "Out" Then
    Cmptter = Cmptter + 1
    End If
Next
 
Worksheets("Stats").Activate
 
Cells(22, 4) = Cmpt
Cells(22, 8) = Cmptbis
Cells(22, 6) = Cmptter
 
 
 
End Sub

Merci pour vos permieres réponse.

Ps j espere que mon code ne sera pas trop long

Re,

Voici une traduction brute de ce que je te proposais, en gardant tout le reste de ta méthode

Code:

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
Sub Bouton1_Clic()
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim m As Integer
Dim Cmpt As Integer
Dim Cmptgeo As Integer
Dim StrBuf As String
Dim StrBufbis As String
Dim Addstage As Integer
Dim AddGeo As Integer
Dim Cmptter As Integer
Dim vR As Variant
Dim vS As Variant
 
i = 2
j = 2
vR = ThisWorkbook.Worksheets("Rtest").Range("A1:H32765").Value
vS = ThisWorkbook.Worksheets("Stats").Range("A1:K32765").Value
 
'boucle qui me permet de connaitre le nombre de sociétés avec tous les critères ensuite par colonne
 
Do While vR(i, 1) <> ""
    i = i + 1
Loop
 
vS(3, 4) = i - 1
 
'Boucle qui me permet de voir tant que j ai pas atteind la derniere boite de voir si le critère (géographioque par exemple) a deja été ajouté dans les stats géo et si non (cf AddGeo = 1 ou 0) je compte combien de fois je le trouve dans la colonne
 
Do While j < i
 
   AddGeo = 1
   Addstage = 1
   Cmpt = 0
   Cmptgeo = 0
   k = 5
   m = 5
 
   StrBuf = vR(j, 2)
   StrBufbis = vR(j, 6)
 
 
    Do While (vS(k, 3) <> "") And (Addstage = 1)
 
        If StrBuf = vS(k, 3) Then
            Addstage = 0
 
        End If
 
        k = k + 1
    Loop
 
 
    Do While (vS(m, 10) <> "") And (AddGeo = 1)
 
        If StrBufbis = Cells(m, 10).Value Then
            AddGeo = 0
 
        End If
 
        m = m + 1
    Loop
 
 
 
    If Addstage = 1 Then
        For l = 2 To i
            If vR(l, 2) = StrBuf Then
                Cmpt = Cmpt + 1
            End If
        Next l
 
        vS(k, 3).Value = StrBuf
        vS(k, 4).Value = Cmpt
 
    End If
 
    If AddGeo = 1 Then
        For l = 2 To i
            If vR(l, 6) = StrBufbis Then
                Cmptgeo = Cmptgeo + 1
            End If
        Next l
 
        vS(m, 10) = StrBufbis
        vS(m, 11) = Cmptgeo
 
    End If
 
j = j + 1
 
Loop
 
Cmpt = 0
Cmptbis = 0
Cmptter = 0
 
'Autre boucle pour voir les sociétés hors critères.
For l = 1 To i
    If vR(l, 4) = "Out" Then Cmpt = Cmpt + 1
 
    If vR(l, 3) = "Out" Then Cmptbis = Cmptbis + 1
 
    If vR(l, 5) = "Out" Then Cmptter = Cmptter + 1
Next
 
vS(22, 4) = Cmpt
vS(22, 8) = Cmptbis
vS(22, 6) = Cmptter
 
ThisWorkbook.Worksheets("Stats").Range("A1:K32765").Value = vS
 
vR = Empty
vS = Empty
End Sub

J'ai considéré que tu lisais jusqu'en colonne H dans Rtest et que tu écrivais jusqu'en colonne K dans Stats. Sinon, il faut adapter.
J'ai traduit, systématiquement, et bien sûr je n'ai pas pu tester!

En espérant que cela t'aide,

PGZ

22/11/2010, 14h32
Marius76

J ai essayé rapidement le fait de stopper le "Screen Updating" me fait deja gagner beaucoup de temps.

J essaye de suite ta solution pgz

Merci beaucoup pour votre aide !:ccool: