Re : Gestion de stock méthode FIFO
Bonjour à tous, le Forum,
Si ceci peut t'aider .....
Option Explicit
' Code développé par Michel Banzai64 sur le Forum Excel-downloads
' https://www.excel-downloads.com/threads/comment-calculer.83885/
' Que je remercie chaleureusement pour son extrême amabilité.
Private Sub RecapCout()
Application.ScreenUpdating = False
Dim Diko As Object
' Je vais stocker le nom des feuilles à traiter
Dim CurCel As Range
' Cellule à lire dans la liste des feuilles
Dim Fdep As String
' Feuille en cours
Dim FFin As String
' Feuille pour impression
Dim LigD As Long
' Dernière ligne dans la page traitée
Dim LigF As Long
' Numéro de ligne pour écrire les données
Dim LigDate As Long
' Numéro de ligne qui contient la date trouvée dans la page en cours
Dim J As Integer
' Pour des boucles
Dim I As Integer
' Pour des boucles
Dim K As Integer
' Pour des boucles
Dim Nbk As Double 'Integer
' Stockage provisoire des valeurs du Tablo
Dim NbI As Double 'Integer
' Stockage provisoire des valeurs du Tablo
Dim Nom As String
' Nom contiendra le nom de l'ingrédient
Dim QuelleDate As Date
' Contiendra la date cherchée
Dim Tablo() As Variant
' Tableau pour stocker les infos
Dim Indice As Integer
' Nombre d'éléments de mon tableau
Dim Ws As Worksheet
' Pour manipuler aisément les feuilles du classeur
Dim Lig As Integer
' Pour le debogage
Lig = 26
Set Diko = CreateObject("Scripting.Dictionary")
For Each CurCel In [a_Traiter]
' Scrute la plage nommée
If CurCel = "" Then Exit For
' Je suis au bout de la liste
Diko.Add UCase(CurCel.Value), UCase(CurCel.Value)
' Passes tout en majuscules : Moins de tracas
Next CurCel
If Diko.Count = 0 Then Exit Sub
' Si pas de feuilles à traiter je quitte
FFin = Feuille_07
QuelleDate = Sheets(FFin).Range("A4")
' Je récupère la date
Sheets(FFin).Range("A8:C55").ClearContents
' j'efface la zone à imprimer
LigF = 8
' A partir de quelle ligne je vais copier
For Each Ws In ThisWorkbook.Sheets
' Je regarde toutes les feuilles du classeur
If Diko.Exists(UCase(Ws.Name)) Then ' Feuille dans la liste donc je traite
LigDate = 0
' A chaque feuille date inconnue
Fdep = Ws.Name
With Sheets(Fdep)
LigD = .Range("A65536").End(xlUp).Row
' Jusqu'ou je vais lire les données
For I = 6 To LigD
' je recherche si une date concorde
If .Cells(I, 1) = QuelleDate Then
LigDate = I
Exit For
End If
Next I
If LigDate > 0 Then
' On a trouvé une date
For J = 10 To 256 Step 4
' Regarder dans toutes les colonnes 'S'
If .Cells(4, J) <> "S" Then Exit For
' Si plus de 'S' j'ai fini mon boulot
If .Cells(LigDate, J) <> "" Then
' Si une opération ce jour la
Nom = .Cells(2, J - 2)
' Récupère le nom du produit
For I = 6 To LigDate
' Du haut da zone jusqu'a la ligne de la date
If .Cells(I, J) <> "" Or .Cells(I, J - 1) <> "" Then
'soit une 'Entrée' soit une 'Sortie'
Indice = Indice + 3
' Dimension de mon taleau (3 valeurs a ajouter)
ReDim Preserve Tablo(Indice)
' J'augmente la taille de mon tableau
Tablo(Indice - 2) = .Cells(I, J - 2)
' stocke le prix
Tablo(Indice - 1) = IIf(.Cells(I, J - 1) <> "", .Cells(I, J - 1), 0)
' soit la valeur 'Entrée' si existante , soit 0
Tablo(Indice) = IIf(.Cells(I, J) <> "", .Cells(I, J), 0)
' Soit la valeur 'Sortie' si existante , soit 0
End If
Next I
End If
If Indice > 0 Then
' Quelque chose dans le tableau
With Sheets(FFin)
For I = 3 To UBound(Tablo) Step 3
' Décalage pour avoir les 'Sortie'
K = 2
' Décalage pour avoir les 'Entrée'
While Tablo(I) > 0
' Tant que la valeur 'Sortie' est > 0
If Tablo(K) > 0 Then
' Quelque chose mis en 'Entrée'
Nbk = Tablo(K)
' stocke ces valeurs car les originaux vont etre modifiés
NbI = Tablo(I)
If I = UBound(Tablo) Then
' On traite les valeurs de la date cherchée ?
.Cells(LigF, 1) = Nom
' Si oui ecrit le nom du produit
.Cells(LigF, 2) = IIf(Nbk > NbI, NbI, Nbk)
' La quantite
.Cells(LigF, 3) = Tablo(K - 1)
' La valeur
LigF = LigF + 1
' On écrira sur la ligne suivante
End If
Tablo(K) = Tablo(K) - IIf(Nbk > NbI, NbI, Nbk)
' On ajuste les valeurs
Tablo(I) = Tablo(I) - IIf(Nbk > NbI, NbI, Nbk)
End If
K = K + 3
' On se positionne sur la valeur 'Entrée' suivante
Wend
' On boucle
Next I
' On sort
Indice = 0
' Si on recommence un autre tableau
End With
' Fin de saisie dans la page Recap
End If
' Fin de Quelque chose dans le tableau
Next J
' Aller voir une autre zone de données
End If
' Fin de date trouvée dans la page
End With
' Fin de With Sheets(FDep)
End If
Next Ws
' On va voir la prochaine feuille
Application.ScreenUpdating = True
End Sub
'
' Le tableau peut ressembler à ceci
'
' Jour quelconque en 'Entrée' 2 et RIEN en 'Sortie'
' Jour cherché en 'Entrée' 3 et 4 en 'Sortie'
' Je suis au traitement du Jour cherché ( I = UBound(Tablo) )
' Jour quelconque | Jour cherché
' Elément |Elément|Elément|Elément|Elément|Elément|
' X + 0 | X + 1 | X + 2 | X + 3 | X + 4 | X + 5 |
' Prix |Entrée |Sortie | Prix |Entrée |Sortie |
' P1 | 2 | 0 | P2 | 3 | 4 | : Tableau départ
' P1 | 0 | 0 | P2 | 3 | 2 | : Passage 1 - Inscription : Produit Quantité (2) Prix (P1)
' P1 | 0 | 0 | P2 | 1 | 0 | : Passage 2 - Inscription : Produit Quantité (2) Prix (P2)
En vous souhaitant un bon dimanche.
