Bordereau Quantite Sortie et stock

Wassss

XLDnaute Nouveau
Bonjour ,

apres plusieurs recherches je viens a vous pour demander de l'aide

j'ai des medicaments avec leurs stock dans une feuille "Stock" et j'ai une autre feuille "Mvts" dans laquelle j'enregistre les mouvements "sortie/entrer" de mes medicaments par date.

je doit remplir un bordereau chaque 15 jours dans lequel je renseigne la quantite sortie par jour et la quantite total sortie dans cette quinzaine et le stock qui me reste pour chaque medicament

pouvez vous m'aider a creer une formule pour automatiser tout cela , avec un calendrier pour choisir la date du debut et la fin de ma quinzaine ?

je vous remerci d'avance
 

Pièces jointes

  • exemple.xls
    38.5 KB · Affichages: 195
  • exemple.xls
    38.5 KB · Affichages: 123
  • exemple.xls
    38.5 KB · Affichages: 129

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Bordereau Quantite Sortie et stock

Bonsoir Wassss,

Un petit fichier sans prétention. Choisir la période => le tableau se met à jour. Les formules ne tiennent compte que des 10000 premières lignes de la feuille mouvement.
 

Pièces jointes

  • Bordereau Stock v1.xls
    152 KB · Affichages: 127

Wassss

XLDnaute Nouveau
Re : Bordereau Quantite Sortie et stock

Bonsoir mapomme
tout d'abord je vous remerci pour cette aide precieuse !

vu que j'ai des centaines de medicaments et des milliers de lignes chaque quinzaine , comment je pourrai desactiver la mise a jour automatique du tableau (ça allourdi mon fichier) et creer par exemple un bouton dans un userform qui me permet de choisir la periode et apres metre a jour mon tableau ?

comment je pourrais afficher toujours les medicaments dans le tableau dans l'ordre avec lequel ils sont affichés dans ma feuille "Stock" ?

ma quinzaine ne commence pas toujours le 1ere ou le 16 du mois , elle peu etre par exemple du 19/06/2012 au 03/07/2012 , comment je pourrais choisir le jours du debut de ma quinzaine ? je donne un exemple en PJ mais j'arrive pas a l'integrer dans ton exemple .

encore merci .
 

Pièces jointes

  • wasss.xls
    51 KB · Affichages: 95
  • wasss.xls
    51 KB · Affichages: 112
  • wasss.xls
    51 KB · Affichages: 109
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Re : Bordereau Quantite Sortie et stock

Bonjour,
Je voulais enlever les formules sommprod mais pas encore réussit.
Voici le résultat (à voir)
Bruno
 

Pièces jointes

  • wasss.xls
    75 KB · Affichages: 90
  • wasss.xls
    75 KB · Affichages: 87
  • wasss.xls
    75 KB · Affichages: 78

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : Bordereau Quantite Sortie et stock

Bonsoir Wassss,

Un essai sans formule une fois le résultat affiché. On doit choisir le début de la période et la fin de période. On ne peut excéder 17 jours de statistiques.

Le code est dans le module de la feuille "Bordereau"
VB:
Option Explicit

Sub Bordero()
Dim Dico, xCell As Range, i As Long, j As Long
Dim Source(), Indice As Long, NewDico, Mazone As Range
Dim DateInf As Date, DateSup As Date, NbrJours As Long

Application.ScreenUpdating = False
'création dico principal
Set Dico = CreateObject("Scripting.Dictionary")
'Récup Dates
DateInf = Range("Date_Inf"): DateSup = Range("Date_Sup")
'Recup Nonbre de jours
NbrJours = Range("Nbr_Jours")
'vérification
If NbrJours <= 0 Or NbrJours > 17 Then
  MsgBox "Le nombre de jours est soit négatif soit supérieur à 17 : Abandon!"
  Exit Sub
End If

'passage des données Mvts dans le tableau Source
With Sheets("Mvts")
  Source = .Range(.Range("A3"), .Cells(.Rows.Count, "a").End(xlUp)).Resize(, 3).Value
End With

'Récupération dans le dico principal des noms des médoc en stock
With Sheets("Stock")
  For Each xCell In .Range("b2", .Range("b2").End(xlDown))
      If Not Dico.Exists(xCell.Value) Then
        'création d'un dico secondaire de clef 1 à Nbrjours et
        'chaque valeur (de 1 à Nbrejours) initialisée à zéro
        Set NewDico = CreateObject("Scripting.Dictionary")
        For j = 1 To NbrJours: NewDico.Add j, 0: Next j
        'On ajoute au dico principal le dico secondaire avec
        'la clef = le nom du médoc
        Dico.Add xCell.Value, NewDico
      End If
  Next xCell
End With

'On recommence la même chose avec les médoc de la feuille Mvts
For i = LBound(Source) To UBound(Source)
    If Not Dico.Exists(Source(i, 2)) Then
      Set NewDico = CreateObject("Scripting.Dictionary")
      For j = 1 To NbrJours: NewDico.Add j, 0: Next j
      Dico.Add Source(i, 2), NewDico
    End If
Next i

'on somme par jour et par médoc les quantités sorties
For i = LBound(Source) To UBound(Source)
  Indice = Source(i, 1) - DateInf + 1
  If Indice >= 1 And Indice <= NbrJours Then
    Dico(Source(i, 2))(Indice) = Dico(Source(i, 2))(Indice) + Source(i, 3)
  End If
Next i

'Effacement du bordereau
With Sheets("Bordereau")
  .Range("A14:U" & Rows.Count).Clear
  'écriture des résultat
  Dim Clefs
  Clefs = Dico.keys
  Set xCell = .Cells(14, "a")
  For i = 0 To Dico.Count - 1
    xCell = i + 1
    'Nom du médoc (dico principal)
    xCell.Offset(, 1) = Clefs(i)
    'Item du dico secondaire de clef le nom du médoc
    xCell.Offset(, 2).Resize(, NbrJours).Value = Dico(Clefs(i)).items
    Set xCell = xCell.Offset(1)
  Next i
  
  'Formule colonne T
  .Range("T14:T" & .Range("A14").End(xlDown).Row).FormulaR1C1 = _
  "=IF(SUM(RC[-17]:RC[-1])=0,"""",SUM(RC[-17]:RC[-1]))"
  
  'Formule colonne U
  .Range("U14:U" & .Range("A14").End(xlDown).Row).FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(RC2,Stock!R1C2:R1000C3,2,FALSE)),""""," & _
        "IF( VLOOKUP(RC2,Stock!R1C2:R1000C3,2,FALSE)=0,"""",  " & _
        "VLOOKUP(RC2,Stock!R1C2:R1000C3,2,FALSE)))"
        
  'Encadrement
  For i = 7 To 12
    With .Range("A14:U" & .Range("A14").End(xlDown).Row).Borders(i)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
  Next i
  
  'Elimination des zéros
  Set Mazone = .Range("A14:U" & .Range("A14").End(xlDown).Row)
  For Each xCell In Mazone
    If xCell = 0 Then xCell.ClearContents
  Next xCell
  
  'passage en valeurs
  Mazone = Mazone.Value
  
  .Shapes.Range(Array("Rounded Rectangle 1")).Select
  Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Calculs Terminés"
  .Range("B12").Select

End With
MsgBox "Traitement terminé!"
Application.ScreenUpdating = False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C9")) Is Nothing Then
    ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
    Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "Calculer..."
End If
Target.Select
End Sub

NB: il y a plus simple bien sûr; je me suis juste "amusé" avec une imbrication de dico pour voir ce que ça donne au niveau vitesse de traitement et syntaxe.
 

Pièces jointes

  • Bordereau Stock v2.xls
    90 KB · Affichages: 90
Dernière édition:

youky(BJ)

XLDnaute Barbatruc
Re : Bordereau Quantite Sortie et stock

Salut à tous,
Comme c'est fait voici le fichier sans formule donc pas besoin de désactiver la mise à jour qui se fait seulement lors du changement de jour ou mois ou année.
Bruno
 

Pièces jointes

  • wasss.xls
    69.5 KB · Affichages: 74
  • wasss.xls
    69.5 KB · Affichages: 83
  • wasss.xls
    69.5 KB · Affichages: 80

Wassss

XLDnaute Nouveau
Re : Bordereau Quantite Sortie et stock

mapomme franchement rien a dire ça répond exactement a mes souhaits et ça va beaucoup m'aider dans mon boulot :D , quant a Bruno merci aussi pour ton essai :)

merci tous les deux d'avoir consacré votre temps pour m'aider
keep up the good work
wasss
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla