Sujet : Achat vente | | Posté le 19-03-2014 ŕ 07:55:23
| Sub valid_cond_vente() 'Controle des elements saisies If Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt"), Range("liste_da"), "<=" & Range("dv"), Range("liste_pdts"), Range("cat_produit")) <> 0 Then 'executer la macro calcul_cout_dachat calcul_cout_dachat 'sinon Else 'afficher "Aucun element dans la base ne correspond aux informations" MsgBox ("Aucun element dans la base ne correspond aux informations saisies" 'fin si End If End Sub Sub calcul_cout_dachat() 'selectionner feuille Achats Sheets("Achats").Select 'selectionner cellule A1 Range("A1").Select 'Tant que la cellule active est differente de la cellule nom_clt Do While ActiveCell <> Range("nom_clt" 'selectionner la 1ere cellule en dessous ActiveCell.Offset(1, 0).Select 'recommencer Loop 'Selectionne cellactive + 3 colonnes ActiveCell.Offset(0, 3).Select 'creer la variable qte_deja_vendue Dim qte_deja_vendue, stock_dispo, cout_d_achat, reste_qte_a_vendre 'qte_deja_vendue est la somme des qtes vendues de produits de categorie saisie, concernant le nom de clt saisi qte_deja_vendue = Application.WorksheetFunction.sumifs(Range("liste_qte_vendue"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) 'Tant que la valeur de la cellule active est inferieure a la qte deja vendue Do While ActiveCell < qte_deja_vendue 'selectionner la 1ere cellule en dessous ActiveCell.Offset(1, 0).Select 'recommencer Loop 'calcul du stock diponible concernant la cellule de positionnement stock_dispo = ActiveCell - qte_deja_vendue 'si le stock disponible sur la cellule de positionnement est superieur a la qte a vendre alors on peut imputer toute la qte a vendre sur cette cellule de positionnement, et donc calculer directement le cout d'achat definitif If stock_dispo > Range("qte_a_vendre" Then 'calcul du cout d'achat definitif (on peut commencer le calcul de la plus value) cout_d_achat = Range("qte_a_vendre" * ActiveCell.Offset(0, 1) 'sinon (on ne peut imputer toute la qte a vendre a la cellule de qte active. Il faut donc calculer un cout d'achat provisoire et passer a la cellule en dessous de la cellule active pour essayer d'imputer le reste de la qte a vendre) Else 'calcul du cout d'achat provisoire cout_d_achat = stock_dispo * ActiveCell.Offset(0, 1) 'calcul du reste de qte a vendre, apres l'imputation d'une partie de la qte a vendre initialement, sur la cellule du dessus reste_qte_a_vendre = Range("qte_a_vendre" - stock_dispo 'selectionner la 1ere cellule en dessous ActiveCell.Offset(1, 0).Select 'fin si End If 'Tant que la cellule active (la nouvelle cell active) < reste_qte_a_vendre, c a d qu'on ne peut pas imputer la totalite de ce reste_qte_a_vendre a cette cellule active, il faudra calculer le cout d'achat y correspondant, puis l'ajouter au cout d'achat provisoire, pour obtenir un autre cout d'achat provisoire Do While ActiveCell < reste_qte_a_vendre 'imputation de la totalite de la cellule active: calculer un nouveau cout d'achat provisoire, calculer le reste_qte_a_vendre, puis selectionner la 1ere cellule en dessous pour essayer d'imputer ce nouveau reste cout_d_achat = ActiveCell * ActiveCell.Offset(0, 1) + cout_d_achat 'calcul du nouveau reste_a_vendre reste_qte_a_vendre = reste_qte_a_vendre - ActiveCell 'selectionner la 1ere cellule en dessous ActiveCell.Offset(1, 0).Select Loop 'calcul du cout d'achat definitif: dernier cout d'achat provisoire + cout d'achat correspondant au reste_qte_a_vendre cout_d_achat = cout_d_achat + reste_qte_a_vendre * ActiveCell.Offset(0, 1) 'affecter le cout d'achat definitif a la cellule cachat Range("cachat" = cout_d_achat 'selectionner la feuille "saisie_vente" Sheets("Saisie_vente").Select End Sub |
| | Posté le 19-03-2014 ŕ 07:55:49
| Sub Verif_conditions() Dim ctrl ctrl = Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt"), Range("liste_da"), "<=" & Range("dv"), Range("liste_pdts"), Range("cat_produit")) MsgBox (ctrl) End Sub Sub stock_dispo() Dim stock_dispo, stock_achete, qte_deja_vendue stock_achete = Application.WorksheetFunction.sumifs(Range("qte_a"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) qte_deja_vendue = Application.WorksheetFunction.sumifs(Range("liste_qte_vendue"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) stock_dispo = stock_achete - qte_deja_vendue MsgBox (stock_dispo) End Sub Sub brouillon() 'Conditions If Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt"), Range("liste_da"), "<=" & Range("dv"), Range("liste_pdts"), Range("cat_produit")) <> 0 Then 'Selectionner la feuille achats Sheets("Achats").Select 'Selectionner la cellule portant la categorie de produit saisie en "Produit" dans la feuilles Saisie_vente Range("D1").Select 'Selectionner la 1ere cellule en dessous de la cellule active tant que celle-ci est differente de la cellule cat_produit Do While ActiveCell.Offset(0, -1) <> Range("cat_produit" 'Descendre d'une ligne ActiveCell.Offset(1, 0).Select 'recommencer Loop Dim stock_dispo, stock_achete, qte_deja_vendue stock_achete = Application.WorksheetFunction.sumifs(Range("qte_a"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) qte_deja_vendue = Application.WorksheetFunction.sumifs(Range("liste_qte_vendue"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) stock_dispo = stock_achete - qte_deja_vendue If stock_dispo > qte_a_vendre Then Dim cout_dachat If ActiveCell < Range("qte_a_vendre" Then cout_dachat = ActiveCell * ActiveCell.Offset(0, 1) stock_dispo = stock_dispo - ActiveCell MsgBox ("Votre Cout d'achat est de " & cout_dachat & " €, et votre Nouveau stock disponible est de " & stock_dispo & " unite (s)" Sheets("Saisie_vente").Select End If End If Else MsgBox ("Veuillez verifier les elements saisis" End If End Sub |
| | Posté le 19-03-2014 ŕ 07:56:12
| Sub Macro1() ' ' Macro1 Macro ' ' Cells.Select ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Add Key:=Range("A1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Achats").Sort .SetRange Range("A2:E6" .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub Sub Macro2() ' ' Macro2 Macro ' ' ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Clear ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Add Key:=Range("A1"), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("Achats").Sort .SetRange Range("A2:E7" .Header = xlNo .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub |
|
|
|