Forum alliance ogame
Administrateurs : divin, teddy
 
 Forum alliance ogame  UNIVERS 8  Guilde du commerce 

 Exercice FIFO

Nouveau sujet   Répondre
 
Bas de pagePages : 1  
Cucur
6 messages postés
   Posté le 19-03-2014 à 01:07:28   Voir le profil de Cucur (Offline)   Répondre à ce message   Envoyer un message privé à Cucur   

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




--------------------
Cucur
6 messages postés
   Posté le 19-03-2014 à 07:52:30   Voir le profil de Cucur (Offline)   Répondre à ce message   Envoyer un message privé à Cucur   

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

--------------------
Haut de pagePages : 1  
 
 Forum alliance ogame  UNIVERS 8  Guilde du commerce  Exercice FIFONouveau sujet   Répondre
 
Identification rapide :         
 
Divers
Imprimer ce sujet
Aller à :   
 
créer forum