| Dernières réponses | |  Sub valid_clt()
'Cette macro comprend les règles de vzlidation du calcul à effectuer
'La première étape consiste à vérifier qu'un client a déjà acheté des produits
'La fonction countifs (NB.SI.ENS) permet de compter le nombre de fois qu'une occurence apparaît dans une BDD... Ici, si
'Le nombre de fois que le nom d'un client apparaît dans la BDD liste_clts est égale à 0, alors le message d'erreur apparaît
'Il faut ensuite sélectionner la cellule nom_clt pour que l'utilisateur puisse corriger sa saisie
If Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt")) = 0 Then
MsgBox "Le client n'existe pas dans la base de donnée, ou l'information est manquante.", vbCritical, "Erreur"
Range("nom_clt").Select
Else
'La deuxième étape consiste à vérifier qu'un client a déjà acheté le produit saisi
'La fonction countifs (NB.SI.ENS) permet de compter le nombre de fois qu'une occurence apparaît dans une BDD... Ici, si
'Le nombre de fois qu'un client existant dans la BDD a acheté le produit saisi est égal à 0, alors le message d'erreur apparaît
'Il faut ensuite sélectionner la cellule cat_produit pour que l'utilisateur puisse corriger sa saisie
If Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit")) = 0 Then
MsgBox "Ce client n'a jamais acheté ce produit, ou l'information est manquante.", vbCritical, "Erreur"
Range("cat_produit").Select
Else
'La troisième étape consiste à vérifier qu'un client a déjà acheté le produit saisi avant la date de vente
'La fonction countifs (NB.SI.ENS) permet de compter le nombre de fois qu'une occurence apparaît dans une BDD... Ici, si
'Le nombre de fois qu'un client existant dans la BDD a acheté le produit saisi avant la date de vente est égal à 0,
'alors le message d'erreur apparaît
'Il faut ensuite sélectionner la cellule dv pour que l'utilisateur puisse corriger sa saisie
If Application.WorksheetFunction.CountIfs(Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), Range("cat_produit"), _
Range("liste_da"), "<=" & Range("dv").Value2) = 0 Then
MsgBox "Ce client n'a jamais acheté ce produit avant cette date, ou l'information est manquante.", vbCritical, "Erreur"
Range("dv").Select
Else
'La dernière étape consiste à vérifier si le client dispose de suffisament de produits en stock.
'Pour cela, on va créer 2 variables: qte_achetee et qte_vendue
'qte_achetee sera égale à la somme des quantités achetées du produit en cours de saisie, pour le client en cours de saisie, à la date
'en cours de saisie
'qte_vendue sera égale à la somme des quantités vendues du produit en cours de saisie, pour le client en cours de saisie, à la date
'en cours de saisie
Dim qte_achetee, qte_vendue, qte_stock
qte_achetee = Application.WorksheetFunction.SumIfs(Range("qte_a"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), _
Range("cat_produit"), Range("liste_da"), "<=" & Range("dv").Value2)
qte_vendue = Application.WorksheetFunction.SumIfs(Range("liste_qte_v"), Range("liste_clts_v"), Range("nom_clt"), _
Range("liste_pdts_v"), Range("cat_produit"), Range("liste_dv"), "<=" & Range("dv").Value2)
qte_stock = qte_achetee - qte_vendue
'A ce stade, nous stade, nous disposons de la quantité déjà achetée et de la quantité déjà vendue, donc si la quantité en cours de saisie
'est supérieure à la quantité en stock (qte_achetee - qte_vendue), alors il faudra un message d'erreur.
If Range("qte_a_vendre" > qte_stock Then
'Ce message doit permettre d'ajuster la valeur de la quantité à vendre à la quantité en stock
If MsgBox("Il ne reste plus que" & qte_stock & "produit(s) disponible(s) en stock ! Voulez-vous ajuster la quantité à vendre", _
vbExclamation + vbYesNo, "Pb de stock" = vbYes Then
Range("qte_a_vendre" = qte_stock
Else
Range("qte_a_vendre").ClearContents
End If
Else
calcul_pv
End If
End If
End If
End If
End Sub
Sub calcul_pv()
'Pour commencer le calcul, il est impératif de trier les achats et les ventes par client, produit et date
Sheets("Achats").Select
tri_achat
Sheets("Ventes").Select
tri_vente
'Dans la feuille Achats, je dois me positionner sur la première ligne concernant le client et le produit en cours
'de vente
Dim qte_achetee, qte_vendue, qte_stock
qte_achetee = Application.WorksheetFunction.SumIfs(Range("qte_a"), Range("liste_clts"), Range("nom_clt"), Range("liste_pdts"), _
Range("cat_produit"), Range("liste_da"), "<=" & Range("dv").Value2)
qte_vendue = Application.WorksheetFunction.SumIfs(Range("liste_qte_v"), Range("liste_clts_v"), Range("nom_clt"), _
Range("liste_pdts_v"), Range("cat_produit"), Range("liste_dv"), "<=" & Range("dv").Value2)
qte_stock = qte_achetee - qte_vendue
Sheets("Achats").Select
Range("A1").Select
Do While ActiveCell <> Range("nom_clts"
ActiveCell.Offset(1, 0).Select
Loop
Do While ActiveCell.Offset(0, 2) <> Range("cat_produit"
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 3).Select
'A ce stade, je suis sur la première ligne de produit pour le client en cours de saisie.
'Je dois maintenant trouver à partir de quelle ligne mon calcul doit se faire.
'Pour cela, j'ai calculé précédemment la variable qte_vendue qui est égale à la somme des quantités vendues
'des quantités vendues pour le produit, le client et avant la date en cours de saisie.
'Tant que la variable qte_vendue est supérieure à la cellule active (quantité
Do While ActiveCell > qte_vendue
'Je retranche de la variable qte_vendue la valeur de la cellule active
qte_vendue = qte_vendue - ActiveCell
'Et je descends d'une ligne
ActiveCell.Offset(1, 0).Select
Loop
'A ce stade, je suis arrivé à la première ligne permettant de calculer ma valorisation
'Reste à déterminer la quantité résiduelle utilisable sur la première ligne où je me trouve
Dim qte_residuelle
qte_residuelle = ActiveCell - qte_vendue
Dim qte_a_vendre, cout_achat
qte_a_vendre = Range("qte_a_vendre"
If qte_residuelle >= qte_a_vendre Then
cout_achat = qte_a_vendre * ActiveCell.Offset(0, 1)
Else
cout_achat = qte_residuelle * ActiveCell.Offset(0, 1)
ActiveCell.Offset(1, 0).Select
qte_a_vendre = qte_a_vendre - qte_residuelle
Do While qte_a_vendre > ActiveCell
cout_achat = cout_achat + ActiveCell * ActiveCell.Offset(0, 1)
qte_a_vendre = qte_a_vendre - ActiveCell
ActiveCell.Offset(1, 0).Select
Loop
cout_achat = cout_achat + qte_a_vendre * ActiveCell.Offset(0, 1)
Range("c_achat" = cout_achat
Sheets("Saisie_vente").Select
End If
'cout_achat = 0
'Do While qte_a_vendre > qte_residuelle
'cout_achat = cout_achat + qte_residuelle * ActiveCell.Offset(0, 1)
'qte_a_vendre = qte_a_vendre - qte_residuelle
'ActiveCell.Offset(1, 0).Select
'qte_residuelle = ActiveCell
'Loop
'cout_achat = cout_achat + qte_a_vendre * ActiveCell.Offset(0, 1)
'MsgBox cout_achat
'Range("c_achat" = cout_achat
'Sheets("saisie_vente").Select
End Sub |
| | Sub tri_achat()
'
' tri_achat Macro
'
'
Range("A1:E5").Select
ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Add Key:=Range("liste_clts"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Add Key:=Range("liste_pdts"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Achats").Sort.SortFields.Add Key:=Range("liste_da"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Achats").Sort
.SetRange Range("A:E"
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub tri_vente()
'
' tri_vente Macro
'
'
Range("A1:E2").Select
ActiveWorkbook.Worksheets("Ventes").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ventes").Sort.SortFields.Add Key:=Range("liste_clts_v"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Ventes").Sort.SortFields.Add Key:=Range("liste_pdts_v"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Ventes").Sort.SortFields.Add Key:=Range("liste_dv"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Ventes").Sort
.SetRange Range("A:E"
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Edité le 19-03-2014 à 07:51:35 par Cucur
|
|
|