Lenteur execution macro

Version imprimable

Bonjour a tous,

Je vous expose mon petit souci ( je suis sous excel 2007 )
Mon classeur excel comporte :
-les feuilles des mois : "Janvier" ; "Février" ; etc etc...
Sur chacune d'elles une liste de produit

-la feuille "Produits" avec la liste des produits en vente "Total acheté" + " stock restant"

-une feuille "Récap" ( qui reprend mois par mois la quantité de produits vendu grâce à se code ) :

Code:

=SI($B9="";"";(SI(ESTERREUR(NB.SI(INDIRECT(C$8&"!M12:M1000");$B9));"";NB.SI(INDIRECT(C$8&"!M12:M1000");$B9))))

le calcul s'effectue ainsi :

Quand on selectionne un produit en janvier , février etc etc ,
celui-ci s'enléve du stock ( feuille "Produits" ),
ajoute se produit dans la feuille "Récap",

J'utilise cette macro dans ThisWorkbook :
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 Option Explicit Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim DerLig As Long Dim LgFin As Long Dim J As Long Dim Cel As Range Dim Ws As Worksheet Select Case Sh.Name Case "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre" If Target.Column <> 13 Then Exit Sub Set Ws = Sheets("Récap") With Sheets("Produits") DerLig = .Range("D" & Rows.Count).End(xlUp).Row ' La dernière ligne dans la page Produit .Range("E2:E" & DerLig).Copy .Range("F2") ' On copie le stock initial dans le stock final LgFin = Ws.Range("B" & Rows.Count).End(xlUp).Row ' La dernière ligne dans la page Récap For J = 9 To LgFin ' Pour chaque produit ' On cherche dans la page "Produit" la cellule correspondante Set Cel = .Range("D2:D" & DerLig).Find(what:=Ws.Range("B" & J), LookIn:=xlValues, lookat:=xlWhole) If Not Cel Is Nothing Then ' Si trouvée ' Le stock final est égal au stock initial - le total des ventes dans l'année Cel.Offset(0, 2) = Cel.Offset(0, 1) - Application.Sum(Ws.Range("C" & J & ":N" & J)) Else MsgBox "Produit inexistant : " & Ws.Range("B" & J) End If Next J End With End Select End Sub
Viens s'ajouter a cela 1 modules :

1 module pour ajouter du stock grâce à un bouton :
Code:

1 2 3 4 5 6 7 8 9 10 Option Explicit Sub Actualise() If Val(Range("A10")) <> 0 Then If ActiveCell.Row > 1 And ActiveCell.Column = 4 And ActiveCell <> "" Then ActiveCell.Offset(0, 1) = ActiveCell.Offset(0, 1) + Range("A10") ActiveCell.Offset(0, 2) = ActiveCell.Offset(0, 2) + Range("A10") End If End If End Sub
ce Module rajoute du stock sur 2 colonnes dans la feuille "Produits" afin de voir le total de produit acheté et le total restant en stock

Probléme :

Tout fonctionne trés bien a cela prés que le calcul ne s'effectue pas assez rapidement, il faut au moins 5 secondes et mon classeur va comporter d'autres fonctions comme "fichiers client" avec repére du meilleur client, fichier facture, fournisseurs etc etc
Existe -t - il une facon d' accélérer le processus

Je suis conscient que 2 calcul s'effectue sur la feuille " Récap " par le code puis par la macro , mais s'était pour moi la seul façon de bien mettre à jour le stock et de prendre en compte le module pour ajouter du stock

Merci pour vos aides futur

Essaies ceci

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim DerLig As Long, LgFin As Long, j As Long
Dim Ws As Worksheet
Dim Cel As Range
 
With Application
    .ScreenUpdating = False
    .Calculation = xlManual
    .EnableEvents = False
End With
Select Case Sh.Name
    Case "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"
        If Target.Column <> 13 Then Exit Sub
        Set Ws = Sheets("Récap")
        With Sheets("Produits")
            DerLig = .Range("D" & .Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Produit
            .Range("E2:E" & DerLig).Copy .Range("F2")    ' On copie le stock initial dans le stock final
            LgFin = Ws.Range("B" & Ws.Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Récap
            For j = 9 To LgFin                   ' Pour chaque produit
                ' On cherche dans la page "Produit" la cellule correspondante
                Set Cel = .Range("D2:D" & DerLig).Find(what:=Ws.Range("B" & j), LookIn:=xlValues, lookat:=xlWhole)
                If Not Cel Is Nothing Then       ' Si trouvée
                    ' Le stock final est égal au stock initial - le total des ventes dans l'année
                    Cel.Offset(0, 2) = Cel.Offset(0, 1) - Application.Sum(Ws.Range("C" & j & ":N" & j))
                    Set Cel = Nothing
                Else
                    MsgBox "Produit inexistant : " & Ws.Range("B" & j)
                End If
            Next j
        End With
        Set Ws = Nothing
End Select
 
With Application
    .ScreenUpdating = True
    .Calculation = xlAutomatic
    .EnableEvents = True
End With
End Sub

10/12/2011, 13h53
francky62000

bonjour,

Ca va plus vite en effet , sauf que le calcul ne s'effectue plus sur la feuille " Récap " et le décompte du stock , ne se fait plus non plus

Enlève les ligne 8 et 36 du code proposé

EDIT

Oups, je n'avais pas vu la ligne

Code:

Id Target.Column<>13

Re essayes celui là

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim DerLig As Long, LgFin As Long, j As Long
Dim Ws As Worksheet
Dim Cel As Range
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
Select Case Sh.Name
    Case "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"
        If Target.Column = 13 Then
            Set Ws = Sheets("Récap")
            With Sheets("Produits")
                DerLig = .Range("D" & Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Produit
                .Range("E2:E" & DerLig).Copy .Range("F2")    ' On copie le stock initial dans le stock final
                LgFin = Ws.Range("B" & Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Récap
                For j = 9 To LgFin               ' Pour chaque produit
                    ' On cherche dans la page "Produit" la cellule correspondante
                    Set Cel = .Range("D2:D" & DerLig).Find(what:=Ws.Range("B" & j), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Cel Is Nothing Then   ' Si trouvée
                        ' Le stock final est égal au stock initial - le total des ventes dans l'année
                        Cel.Offset(0, 2) = Cel.Offset(0, 1) - Application.Sum(Ws.Range("C" & j & ":N" & j))
                        Set Cel = Nothing
                    Else
                        MsgBox "Produit inexistant : " & Ws.Range("B" & j)
                    End If
                Next j
            End With
            Set Ws = Nothing
        End If
End Select
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

10/12/2011, 14h10
francky62000

bonjour,

mon stock en F2, ne se met plus a jour
10/12/2011, 14h30
mercatog

Peux tu joindre un extrait de ton fichier?
10/12/2011, 16h06
francky62000

1 pièce(s) jointe(s)

le voici

Si tu arrives a faire quelque chose merci de me donner aussi des explications , histoire que je m'endorme un peu moins idiot .

Merci

J'ai revu ton code en utilisant ce code, tout est OK

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
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim DerLig As Long, LgFin As Long, j As Long
Dim Ws As Worksheet
Dim Cel As Range
 
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With
Select Case Sh.Name
    Case "Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre"
        If Target.Column = 13 Then
            Set Ws = Sheets("Récap")
            With Sheets("Produits")
                DerLig = .Range("D" & .Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Produit
                .Range("E2:E" & DerLig).Copy .Range("F2")    ' On copie le stock initial dans le stock final
                LgFin = Ws.Range("B" & Rows.Count).End(xlUp).Row    ' La dernière ligne dans la page Récap
                For j = 9 To LgFin               ' Pour chaque produit
                    ' On cherche dans la page "Produit" la cellule correspondante
                    Set Cel = .Range("D2:D" & DerLig).Find(what:=Ws.Range("B" & j), LookIn:=xlValues, lookat:=xlWhole)
                    If Not Cel Is Nothing Then   ' Si trouvée
                        ' Le stock final est égal au stock initial - le total des ventes dans l'année
                        Cel.Offset(0, 2) = Cel.Offset(0, 1) - Application.Sum(Ws.Range("C" & j & ":N" & j))
                        Set Cel = Nothing
                    Else
                        MsgBox "Produit inexistant : " & Ws.Range("B" & j)
                    End If
                Next j
            End With
            Set Ws = Nothing
        End If
End Select
 
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

Néanmoins, la conception de ton fichier est à revoir et même à l'envers de ce que tu fais. Tu te trouveras trop vite avec une usine à gaz.

Mettre une feuille comme base de donnée où l'utilisateur entre toutes les opérations. L'analyse des données se fera en prenant en compte la date de l'opération.

Une bonne conception est 90% du travail. (peut être j'exagère sur le pourcentage)

10/12/2011, 17h01
francky62000

Je te remercie; je t'avouerai que c'est ma première expérience avec excel et macro.
Je ne connais pas encore bien le concept , cela dit j'apprends assez vite et si bien sur tu as une autre conception afin de rendre l'usine a gaz plus volatile , j'écoute tout ce qui est bon a prendre.
C'est ma première mouture , je pense que tu l'as ressentie mais qui en amèneront d'autres et j’espère fortement progresser.

Encore merci
10/12/2011, 17h39
mercatog

Tu as conçu ton classeur par mois, c'est à dire, l'utilisateur enregistre les opérations du mois X dans la feuille X.

Ce que je propose que tu réserve une seule feuille BD à la saisie des opérations. Et comme tu as "un champ" date pour chaque opération, tu peux après dispatcher les données que tu veux par mois.

De ce faite, une unique feuille pour la saisie et des états de sortie basées sur cette feuille à ta guise.
10/12/2011, 19h25
francky62000

Je comprends pas tout, tu aurais un exemple