Merci de ta rapidité. Je regarde avec attention.Bonsoir,
Une proposition.
Cordialement.
Option Explicit
Dim Tbl, Stk%, TQE%, TQS%, n2&, k1&, k2&
Private Sub BlocES()
Cells(k1, 3) = "Entrée": Cells(k2, 3) = "Sortie": Cells(k1, 4).Resize(2) = 0: n2 = n2 + 3
End Sub
Private Sub MvtX(lg&)
Dim Mvt$, Qté%, b As Byte: Mvt = Tbl(lg, 3): Qté = Tbl(lg, 4)
If Mvt = "Entrée" Then
TQE = TQE + Qté: Stk = Stk + Qté: Cells(k1, 4) = TQE: b = 1
End If
If Mvt = "Sortie" Then
TQS = TQS + Qté: Stk = Stk - Qté: Cells(k2, 4) = TQS: b = 2
End If
If b > 0 Then Cells(k2, 6) = Stk: Tbl(lg, 5) = 1
End Sub
Sub RécapTyp()
If ActiveSheet.Name <> "Mvts" Then Exit Sub
Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub
Dim sh As Worksheet, cel As Range, ref$, d1 As Date, d2 As Date, i&, j&, k&
Set sh = ActiveSheet: n1 = n1 - 1: Tbl = [A2].Resize(n1, 5): Application.ScreenUpdating = 0
Worksheets("TRT").Select: n2 = Cells(Rows.Count, 3).End(3).Row
If n2 > 1 Then [A2].Resize(n2 - 1, 7).ClearContents 'effacement des anciens résultats
n2 = 2 'les nouveaux résultats seront écrits à partir de la ligne n° 2
For i = 1 To n1
If Tbl(i, 5) = 0 Then
ref = Tbl(i, 1): j = sh.Columns(1).Find(ref, , -4163, 1, 1).Row - 1
If i = j Then
Cells(n2, 1) = ref: d1 = sh.Cells(i + 1, 2): Cells(n2, 2) = d1
Set cel = Worksheets("Stock").Columns(1).Find(ref, , -4163, 1, 1)
If Not cel Is Nothing Then
Stk = cel.Offset(, 1): Cells(n2, 5) = Stk: TQE = 0: TQS = 0
k1 = n2 + 1: k2 = n2 + 2: BlocES: MvtX i
For k = i + 1 To n1
If Tbl(k, 5) = 0 Then
If Tbl(k, 1) = ref Then
d2 = sh.Cells(k + 1, 2)
If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES
MvtX k
End If
End If
Next k
End If
End If
End If
Next i
End Sub
Whouah ouhBonjour Michel, goube,
ton fichier en retour ; à l'ouverture du fichier, tu es sur une nouvelle feuille "TRT" : Tableau Récapitulatif de Type ; à part la ligne n° 1 des en-têtes, tu peux voir que cette feuille est vide ; va sur la feuille "Mvts", et fais Ctrl e ➯ travail effectué !
VB:Option Explicit Dim Tbl, Stk%, TQE%, TQS%, n2&, k1&, k2& Private Sub BlocES() Cells(k1, 3) = "Entrée": Cells(k2, 3) = "Sortie": Cells(k1, 4).Resize(2) = 0: n2 = n2 + 3 End Sub Private Sub MvtX(lg&) Dim Mvt$, Qté%, b As Byte: Mvt = Tbl(lg, 3): Qté = Tbl(lg, 4) If Mvt = "Entrée" Then TQE = TQE + Qté: Stk = Stk + Qté: Cells(k1, 4) = TQE: b = 1 End If If Mvt = "Sortie" Then TQS = TQS + Qté: Stk = Stk - Qté: Cells(k2, 4) = TQS: b = 2 End If If b > 0 Then Cells(k2, 6) = Stk: Tbl(lg, 5) = 1 End Sub Sub RécapTyp() If ActiveSheet.Name <> "Mvts" Then Exit Sub Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub Dim sh As Worksheet, cel As Range, ref$, d1 As Date, d2 As Date, i&, j&, k& Set sh = ActiveSheet: n1 = n1 - 1: Tbl = [A2].Resize(n1, 5): Application.ScreenUpdating = 0 Worksheets("TRT").Select: n2 = Cells(Rows.Count, 3).End(3).Row If n2 > 1 Then [A2].Resize(n2 - 1, 7).ClearContents 'effacement des anciens résultats n2 = 2 'les nouveaux résultats seront écrits à partir de la ligne n° 2 For i = 1 To n1 If Tbl(i, 5) = 0 Then ref = Tbl(i, 1): j = sh.Columns(1).Find(ref, , -4163, 1, 1).Row - 1 If i = j Then Cells(n2, 1) = ref: d1 = sh.Cells(i + 1, 2): Cells(n2, 2) = d1 Set cel = Worksheets("Stock").Columns(1).Find(ref, , -4163, 1, 1) If Not cel Is Nothing Then Stk = cel.Offset(, 1): Cells(n2, 5) = Stk: TQE = 0: TQS = 0 k1 = n2 + 1: k2 = n2 + 2: BlocES: MvtX i For k = i + 1 To n1 If Tbl(k, 5) = 0 Then If Tbl(k, 1) = ref Then d2 = sh.Cells(k + 1, 2) If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES MvtX k End If End If Next k End If End If End If Next i End Sub
si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.
soan
Comment est ce que je peux mettre à jour au fur et à mesure des saisies les stocks restants dans l'onglet StockWhouah ouh
Je suis impressionné? et bien incapable de concevoir pareil programme.
Je regarde dans le détail
Merci
Michel
Je suis preneur de ta solution, elle m'ouvre des perspectives que je n'ai pas encore abordéesBonsoir,
Une proposition.
Cordialement.
cel.Offset(, 1) = Stk
For k
est donc celui-ci : For k = i + 1 To n1
If Tbl(k, 5) = 0 Then
If Tbl(k, 1) = ref Then
d2 = sh.Cells(k + 1, 2)
If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES
MvtX k
End If
End If
Next k
cel.Offset(, 1) = Stk
End If
End If
End If
Next i
End Sub
C'est parfait@Michel
merci pour avoir choisi ma solution ; voici la nouvelle version de mon fichier, avec mise à jour de la colonne "Quantité", sur la feuille "Stock" ; même utilisation que précédemment ; dans le code VBA, après Next k, j'ai ajouté cette seule instruction :cel.Offset(, 1) = Stk
le bas du code VBA, à partir de la boucleFor k
est donc celui-ci :
VB:For k = i + 1 To n1 If Tbl(k, 5) = 0 Then If Tbl(k, 1) = ref Then d2 = sh.Cells(k + 1, 2) If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES MvtX k End If End If Next k cel.Offset(, 1) = Stk End If End If End If Next i End Sub
soan
Option Explicit
Dim Tbl, Stk%, TQE%, TQS%, n2&, k1&, k2&
Private Sub BlocES()
Cells(k1, 3) = "Entrée": Cells(k2, 3) = "Sortie": Cells(k1, 4).Resize(2) = 0: n2 = n2 + 3
End Sub
Private Sub MvtX(lg&)
Dim Mvt$, Qté%, b As Byte: Mvt = Tbl(lg, 3): Qté = Tbl(lg, 4)
If Mvt = "Entrée" Then
TQE = TQE + Qté: Stk = Stk + Qté: Cells(k1, 4) = TQE: b = 1
End If
If Mvt = "Sortie" Then
TQS = TQS + Qté: Stk = Stk - Qté: Cells(k2, 4) = TQS: b = 2
End If
If b > 0 Then Cells(k2, 6) = Stk: Tbl(lg, 5) = 1
End Sub
Sub RécapTyp()
If ActiveSheet.Name <> "Mvts" Then Exit Sub
Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub
Dim sh As Worksheet, cel As Range, ref$, d1 As Date, d2 As Date, i&, j&, k&
Set sh = ActiveSheet: n1 = n1 - 1: Tbl = [A2].Resize(n1, 5): Application.ScreenUpdating = 0
ActiveCell.Select: Worksheets("TRT").Select: n2 = Cells(Rows.Count, 3).End(3).Row
If n2 > 1 Then [A2].Resize(n2 - 1, 7).ClearContents 'effacement des anciens résultats
n2 = 3 'les nouveaux résultats seront écrits à partir de la ligne n° 3
For i = 1 To n1
If Tbl(i, 5) = 0 Then
ref = Tbl(i, 1): j = sh.Columns(1).Find(ref, , -4163, 1, 1).Row - 1
If i = j Then
Cells(n2, 1) = ref: d1 = sh.Cells(i + 1, 2): Cells(n2, 2) = d1
Set cel = Worksheets("Stock").Columns(1).Find(ref, , -4163, 1, 1)
If Not cel Is Nothing Then
Stk = cel.Offset(, 1): Cells(n2, 5) = Stk: TQE = 0: TQS = 0
k1 = n2 + 1: k2 = n2 + 2: BlocES: MvtX i
For k = i + 1 To n1
If Tbl(k, 5) = 0 Then
If Tbl(k, 1) = ref Then
d2 = sh.Cells(k + 1, 2)
If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES
MvtX k
End If
End If
Next k
cel.Offset(, 1) = Stk: n2 = n2 + 1
End If
End If
End If
Next i
End Sub
Merci@Michel
nouvelle version du fichier ; la feuille "TRT" est vide (sauf les en-têtes) ; va sur la feuille "Mvts" ; fais Ctrl e OU clique sur le bouton "Valider" ➯ travail effectué ! mêmes résultats qu'avant, à partir de la ligne 3, et les références sont séparées par une ligne vide pour une présentation plus aérée ; bien sûr, la mise à jour du Stock (colonne "Quantité") a été faite en feuille "Stock".
VB:Option Explicit Dim Tbl, Stk%, TQE%, TQS%, n2&, k1&, k2& Private Sub BlocES() Cells(k1, 3) = "Entrée": Cells(k2, 3) = "Sortie": Cells(k1, 4).Resize(2) = 0: n2 = n2 + 3 End Sub Private Sub MvtX(lg&) Dim Mvt$, Qté%, b As Byte: Mvt = Tbl(lg, 3): Qté = Tbl(lg, 4) If Mvt = "Entrée" Then TQE = TQE + Qté: Stk = Stk + Qté: Cells(k1, 4) = TQE: b = 1 End If If Mvt = "Sortie" Then TQS = TQS + Qté: Stk = Stk - Qté: Cells(k2, 4) = TQS: b = 2 End If If b > 0 Then Cells(k2, 6) = Stk: Tbl(lg, 5) = 1 End Sub Sub RécapTyp() If ActiveSheet.Name <> "Mvts" Then Exit Sub Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub Dim sh As Worksheet, cel As Range, ref$, d1 As Date, d2 As Date, i&, j&, k& Set sh = ActiveSheet: n1 = n1 - 1: Tbl = [A2].Resize(n1, 5): Application.ScreenUpdating = 0 ActiveCell.Select: Worksheets("TRT").Select: n2 = Cells(Rows.Count, 3).End(3).Row If n2 > 1 Then [A2].Resize(n2 - 1, 7).ClearContents 'effacement des anciens résultats n2 = 3 'les nouveaux résultats seront écrits à partir de la ligne n° 3 For i = 1 To n1 If Tbl(i, 5) = 0 Then ref = Tbl(i, 1): j = sh.Columns(1).Find(ref, , -4163, 1, 1).Row - 1 If i = j Then Cells(n2, 1) = ref: d1 = sh.Cells(i + 1, 2): Cells(n2, 2) = d1 Set cel = Worksheets("Stock").Columns(1).Find(ref, , -4163, 1, 1) If Not cel Is Nothing Then Stk = cel.Offset(, 1): Cells(n2, 5) = Stk: TQE = 0: TQS = 0 k1 = n2 + 1: k2 = n2 + 2: BlocES: MvtX i For k = i + 1 To n1 If Tbl(k, 5) = 0 Then If Tbl(k, 1) = ref Then d2 = sh.Cells(k + 1, 2) If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES MvtX k End If End If Next k cel.Offset(, 1) = Stk: n2 = n2 + 1 End If End If End If Next i End Sub
soan
Je viens de trouver une autre difficulté sur le stock restant@Michel
nouvelle version du fichier ; la feuille "TRT" est vide (sauf les en-têtes) ; va sur la feuille "Mvts" ; fais Ctrl e OU clique sur le bouton "Valider" ➯ travail effectué ! mêmes résultats qu'avant, à partir de la ligne 3, et les références sont séparées par une ligne vide pour une présentation plus aérée ; bien sûr, la mise à jour du Stock (colonne "Quantité") a été faite en feuille "Stock".
VB:Option Explicit Dim Tbl, Stk%, TQE%, TQS%, n2&, k1&, k2& Private Sub BlocES() Cells(k1, 3) = "Entrée": Cells(k2, 3) = "Sortie": Cells(k1, 4).Resize(2) = 0: n2 = n2 + 3 End Sub Private Sub MvtX(lg&) Dim Mvt$, Qté%, b As Byte: Mvt = Tbl(lg, 3): Qté = Tbl(lg, 4) If Mvt = "Entrée" Then TQE = TQE + Qté: Stk = Stk + Qté: Cells(k1, 4) = TQE: b = 1 End If If Mvt = "Sortie" Then TQS = TQS + Qté: Stk = Stk - Qté: Cells(k2, 4) = TQS: b = 2 End If If b > 0 Then Cells(k2, 6) = Stk: Tbl(lg, 5) = 1 End Sub Sub RécapTyp() If ActiveSheet.Name <> "Mvts" Then Exit Sub Dim n1&: n1 = Cells(Rows.Count, 1).End(3).Row: If n1 = 1 Then Exit Sub Dim sh As Worksheet, cel As Range, ref$, d1 As Date, d2 As Date, i&, j&, k& Set sh = ActiveSheet: n1 = n1 - 1: Tbl = [A2].Resize(n1, 5): Application.ScreenUpdating = 0 ActiveCell.Select: Worksheets("TRT").Select: n2 = Cells(Rows.Count, 3).End(3).Row If n2 > 1 Then [A2].Resize(n2 - 1, 7).ClearContents 'effacement des anciens résultats n2 = 3 'les nouveaux résultats seront écrits à partir de la ligne n° 3 For i = 1 To n1 If Tbl(i, 5) = 0 Then ref = Tbl(i, 1): j = sh.Columns(1).Find(ref, , -4163, 1, 1).Row - 1 If i = j Then Cells(n2, 1) = ref: d1 = sh.Cells(i + 1, 2): Cells(n2, 2) = d1 Set cel = Worksheets("Stock").Columns(1).Find(ref, , -4163, 1, 1) If Not cel Is Nothing Then Stk = cel.Offset(, 1): Cells(n2, 5) = Stk: TQE = 0: TQS = 0 k1 = n2 + 1: k2 = n2 + 2: BlocES: MvtX i For k = i + 1 To n1 If Tbl(k, 5) = 0 Then If Tbl(k, 1) = ref Then d2 = sh.Cells(k + 1, 2) If d2 <> d1 Then k1 = k1 + 3: k2 = k2 + 3: Cells(k1, 2) = d2: d1 = d2: BlocES MvtX k End If End If Next k cel.Offset(, 1) = Stk: n2 = n2 + 1 End If End If End If Next i End Sub
soan
C'est juste. Je me suis trompé dans ma demande. Je n'avais pas vu que la mise à jour des stocks était déjà effectuée. Je vais juste essayer de supprimer les colonnes stock dans le tableau TRT. Je te remercie pour ton travail toujours très pédagogique. Grâce aux détails de tes posts je devrais pouvoir supprimer ces colonnes. Merci encore et bonne continuation. MichelBonsoir Michel,
je rappelle que selon ce que tu as écrit dans le fichier joint de ton énoncé, ta demande initiale était celle-ci :
Regarde la pièce jointe 1104119
le fichier de mon post #4 fait ce tableau ; ensuite, tu as demandé la mise à jour des stocks restants ; je l'ai fait dans le fichier joint de mon post #8 ; puis tu as demandé un bouton, et à séparer les références dans le tableau TRT (pour une présentation plus aérée et plus lisible) ; j'ai fait aussi ces 2 autres demandes dans le fichier joint de mon post #10 ; je pense que c'est bien assez pour le présent sujet ; aussi, pour toutes les demandes supplémentaires de tes posts #11 et #12, tu devrais créer un autre sujet ! je laisse à un autre intervenant le soin de t'aider davantage, car là ça devient carrément de la gestion de stock. (alors qu'au début c'était censé être seulement l'établissement d'un tableau récapitulatif de type) ; bonne chance pour la suite de ton projet !
soan
If Not cel Is Nothing Then
j'ai enlevé Cells(n2, 5) = Stk
qui était pour écrire le Stock initial en colonne E ➯ la ligne complète devient :Stk = cel.Offset(, 1): TQE = 0: TQS = 0
Stk = cel.Offset(, 1)
car il est nécessaire pour le calcul progressif du Stock restant, qui sera écrit plus tard en feuille "Stock", colonne B.Cells(k2, 6) = Stk
qui était pour écrire le Stock restant en colonne F ➯ la ligne complète devient :If b > 0 Then Tbl(lg, 5) = 1