Lenteur execution macro

**francky62000** · 10/12/2011, 14h29

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 :

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

=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 :

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
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 :

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

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

**mercatog** · 10/12/2011, 14h42

Essaies ceci

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
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

**francky62000** · 10/12/2011, 14h53

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

**mercatog** · 10/12/2011, 14h57

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

EDIT

Oups, je n'avais pas vu la ligne

Code :

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

Id Target.Column<>13

Re essayes celui là

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
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

**francky62000** · 10/12/2011, 15h10

bonjour,

mon stock en F2, ne se met plus a jour

**mercatog** · 10/12/2011, 15h30

Peux tu joindre un extrait de ton fichier?

**francky62000** · 10/12/2011, 17h06

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

**mercatog** · 10/12/2011, 17h43

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

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
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)

**francky62000** · 10/12/2011, 18h01

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

**mercatog** · 10/12/2011, 18h39

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.

**francky62000** · 10/12/2011, 20h25

Je comprends pas tout, tu aurais un exemple

Lenteur execution macro [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager