Discussion :

[francky62000]

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]

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]

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]

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