[E-03] problème code boucle

Version imprimable

Bonjour,

Je travaille sur un fichier qui contient 2 onglets :
- 1er onglet = liste d'objets avec notamment une colonne prix et une colonne nom de la personne à qui l'objet est affecté (environ 1500 lignes mais beaucoup sont vides pour l'instant)
- 2ème onglet = liste des noms : certains noms n'ont aucun objet affecté dans l'onglet 1 et d'autres en ont plusieurs voire beaucoup (environ 1000 noms au total mais seulement 300 ont au moins 1 objet affecté)

Voilà ce que je veux afficher dans le 2ème onglet :
- colonne W : nombre d'objets affectés
- colonne Y : prix global
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 For Each nom In zone_nom.Cells For Each mag In zone_objet.Cells If nom.Value = objet.Value Then NB = NB + 1 PRIX= PRIX+ CL.Worksheets("OBJETS").Range("P" & objet.Row).Value With CL.Worksheets("NOMS") .Range("W" & nom.Row).Value = NB .Range("Y" & nom.Row).Value = BRUT End With End If Next Next
La macro tourne pendant très longtemps puis message d'erreur dépassement capacité.
c'est vrai que si la macro compare chacune des 1000 lignes à chacune des 1500 lignes, ça prend beaucoup trop de temps.
L'idéal serait qu'elle ne compare "que" les 300 noms de l'onglet 2 qui ont au moins un objet d'affecté aux lignes pour lesquelles la colonne S de l'onglet 1 n'est pas vide.

J'ai voulu essayer d'utiliser un intersect mais je n'ai pas réussi, pouvez-vous m'aider ?

Merci par avance

25/02/2009, 18h07
pgz

Bonjour.

Quelques remarques qui pourraient t'aider.

1. Tu calcules NB et PRIX et tu enregistres NB et BRUT
2. Quand tu changes de nom, tu ne mets à 0, ni NB, ni PRIX, ni BRUT
3. L'écriture dans les colonnes W et Y en cours de scrutation des objets semble bien inutile et ralentit le traitement
4. Tu pourrais inhiber la mise à jour de l'écran pendant le traitement.

Une fois ces pb réglés, si c'est toujours aussi long reviens pour d'autres méthodes.

Cordialement,

PGZ
25/02/2009, 19h25
Emily2711

Bonjour,

Oui effectivement il y avait quelques petites fautes de recopiage mais tout fonctionne ... c'est juste très lent.
25/02/2009, 19h35
pgz

OK.
Peux-tu montrer le code sans erreur de recopie?

PGZ

Oui bien sûr voilà le code :

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
 
Public Sub Calcul()
 
Dim CL As Workbook
Dim NB As Integer
Dim BRUT As Integer
Dim NET As Integer
 
Dim numlig_nom As Integer
Dim zone_nom As Range
Dim nom As Variant
 
Dim numlig_objet As Integer
Dim zone_objet As Range
Dim objet As Variant
 
Set CL = ActiveWorkbook
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
numlig_nom = CL.Worksheets(3).Range("A1").CurrentRegion.Rows.Count
Set zone_nom = CL.Worksheets(3).Range("I2:I" & numlig_nom)
 
numlig_objet = CL.Worksheets(2).Range("A1").CurrentRegion.Rows.Count
Set zone_objet = CL.Worksheets(2).Range("S2:S" & numlig_objet)
 
NB = 0
BRUT = 0
NET = 0
 
For Each nom In zone_nom.Cells
    For Each objet In zone_objet.Cells
            If nom.Value = objet.Value Then
            NB = NB + 1
            BRUT = BRUT + CL.Worksheets(2).Range("P" & objet.Row).Value
            NET = NET + CL.Worksheets(2).Range("Q" & objet.Row).Value
            End If
    Next
            With CL.Worksheets(3)
            .Range("W" & nom.Row).Value = NB
            .Range("Y" & nom.Row).Value = BRUT
            .Range("Z" & nom.Row).Value = NET
            End With
            NB = 0
            BRUT = 0
            NET = 0
Next
 
End Sub

Bonjour.

Je ne comprends pas comment cela peut marcher vu que l'endroit où tu mets NB, BRUT et NET à 0 ne me semble pas bon. Perso, j'aurais plutôt écrit

Code:

1
2
3
4
5
6
7
8
9
10
11
12
...
Set zone_objet = CL.Worksheets(2).Range("S2:S" & numlig_objet)
 
For Each nom In zone_nom.Cells
    NB = 0
    BRUT = 0
    NET = 0
    For Each objet In zone_objet.Cells
            If nom.Value = objet.Value Then
            NB = NB + 1
            BRUT =... 
...

Pour accélérer le traitement, je vois 2 pistes :
- utiliser des tableaux de variables
- utiliser des requêtes.

Comme la première conduit à un code plus proche du tien, je te propose une solution de ce type

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
Public Sub Calcul()
 
Dim shNom As Excel.Worksheet
Dim NumLignNom As Long
Dim TabNomNom() As Variant, TabMontantNom() As Variant
Dim shObjet As Excel.Worksheet
Dim NumLignObj As Long
Dim TabNomObjet() As Variant, TabMontantObjet() As Variant
Dim L As Long, M As Long
 
 
Set shNom = Application.ThisWorkbook.Worksheets(3)
Set shObjet = Application.ThisWorkbook.workshets(2)
 
NumLignNom = shNom.Range("A1").CurrentRegion.Rows.Count
TabNomNom() = shNom.Range("I2:I" & NumLignNom).Value
TabMontantNom = shNom.Range("W2:Z" & NumLignNom).Value
 
NumLignObj = shObjet.Range("A1").CurrentRegion.Rows.Count
TabNomObjet() = shObjet.Range("S2:S" & NumLignObj).Value
TabMontantObjet() = shObjet.Range("P2:Q" & NumLignObj).Value
 
For L = LBound(TabNomNom, 1) To UBound(TabNomNom, 1)
    TabMontantNom(L, 1) = 0
    TabMontantNom(L, 2) = 0
    TabMontantNom(L, 3) = 0
    For M = LBound(TabNomObjet, 1) To UBound(TabNomObjet, 1)
        If TabNomNom(L, 1) = TabNomObjet(M, 1) Then
            TabMontantNom(L, 1) = TabMontantNom(L, 1) + 1
            TabMontantNom(L, 2) = TabMontantNom(L, 2) + TabMontantObjet(M, 1)
            TabMontantNom(L, 3) = TabMontantNom(L, 3) + TabMontantObjet(M, 2)
        End If
    Next M
Next L
 
shNom.Range("W2:Z" & NumLignNom).Value = TabMontantNom
 
Set shNom = Nothing
Set shObjet = Nothing
Erase TabNomNom
Erase TabMontantNom
Erase TabNomObjet
Erase TabMontantObjet
 
End Sub

ATTENTION : J'ai écris du code plutôt qu'un long discours. Mais je n'ai pas ton classeur pour tester. J'ai deviné des paramètres en lisant le code initial. Donc à mettre au point.

Cordialement,

PGZ