Trouvé ce fichier sur :
EQUIT TABLE a été conçu pour répartir de manière la plus équitable possible des valeurs entre plusieurs participant(e)s.
Merci mais ce n'est pas la même problématique (rembourser <> répartir).
Voyons ce qu'en dit notre Tatanka international
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Trouvé ce fichier sur :
EQUIT TABLE a été conçu pour répartir de manière la plus équitable possible des valeurs entre plusieurs participant(e)s.
Merci mais ce n'est pas la même problématique (rembourser <> répartir).
Voyons ce qu'en dit notre Tatanka international
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Trouvé ce fichier sur :
EQUIT TABLE a été conçu pour répartir de manière la plus équitable possible des valeurs entre plusieurs participant(e)s.
Merci mais ce n'est pas la même problématique (rembourser <> répartir).
Voyons ce qu'en dit notre Tatanka international
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
sans macro !!!!
ce qui tendrait à dire que je n'ai rien compris !!!!
Tu as très bien compris et comme d'hab, je suis tombé
sans macro !!!!
ce qui tendrait à dire que je n'ai rien compris !!!!
Tu as très bien compris et comme d'hab, je suis tombé
sans macro !!!!
ce qui tendrait à dire que je n'ai rien compris !!!!
Tu as très bien compris et comme d'hab, je suis tombé
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
Ah oui, ça c'est facile :-) même pas besoin de macro pour ça, une simple colonne et le tour est joué. Maintenant, ce qu'il faut
c'est optimiser les remboursements. Et en prime tu n'oublies pas que personne n'a jamais de monnaie dans ces cas là :-)
bonne soirée :-)))
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
Ah oui, ça c'est facile :-) même pas besoin de macro pour ça, une simple colonne et le tour est joué. Maintenant, ce qu'il faut
c'est optimiser les remboursements. Et en prime tu n'oublies pas que personne n'a jamais de monnaie dans ces cas là :-)
bonne soirée :-)))
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Bonjour au fil,
Un début laborieux mais peut-être prometteur ;-)
AMHA le pire reste à faire !
Ah oui, ça c'est facile :-) même pas besoin de macro pour ça, une simple colonne et le tour est joué. Maintenant, ce qu'il faut
c'est optimiser les remboursements. Et en prime tu n'oublies pas que personne n'a jamais de monnaie dans ces cas là :-)
bonne soirée :-)))
--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" a écrit dans le message de news:%Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news:%23QyygSldIHA.5900@TK2MSFTNGP02.phx.gbl...
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" a écrit dans le message de news:%Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Bonjour Char Abeuh,
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Serge
"Char Abeuh" a écrit dans le message de news:Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" a écrit dans le message de news:%Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Bonjour Char Abeuh,
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Serge
"Char Abeuh" <char.abeuh.aoter@orange.fr> a écrit dans le message de news: uN4MxozdIHA.1376@TK2MSFTNGP02.phx.gbl...
Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" <garnote3@ENLEVER.videotron.ca> a écrit dans le message de news:%23QyygSldIHA.5900@TK2MSFTNGP02.phx.gbl...
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Bonjour Char Abeuh,
Super !
Et la cerise sur le gâteau serait de pouvoir utiliser ta macro
à partir de la sélection des données plutôt que d'entrer les
données dans le code.
Serge
"Char Abeuh" a écrit dans le message de news:Bonsoir,
Une méthode en utilisant les plus grandes différences entre ceux qui doivent et ceux qui reçoivent:
On cherche celui qui a le plus payé
il reçoit de celui qui a le moins payé
et on recommence...
la macro est commentée, les résultats sont dans la fenêtre d'exécution.
Voir ==> http://cjoint.com/?czahHVJL22
La Macro:
Option Explicit
Option Base 1
Public Sub Qui_Donne_A_Qui()
Dim Noms 'noms des convives
Dim Montants 'montants donnés initialement par chaque convive
Dim Deltas 'différences entre ce que chacun a donné et le montant équitable -positif ou négatif)
Dim Nbre As Integer 'Nombre de convives
Dim Equitable As Long 'montant à payer par chacun
Dim Total ' Somme totale
Dim xI As Integer
'initialisation
Noms = Array("Misange", "Modeste", "Stéphane", "Denis", "Monseigneur", "PST", "Isabelle")
Montants = Array(14, 66, 25, 18, 27, 92, 45)
Deltas = Array(0, 0, 0, 0, 0, 0, 0)
'Calcul des du nombre de personnes
Nbre = UBound(Noms) - LBound(Noms) + 1
'calcul du total
Total = 0
For xI = 1 To Nbre
Total = Total + Montants(xI)
Next xI
'calcul du montant à payer par chacun
Equitable = Total / Nbre
'Calcul des deltas de chacun, positif ==> a trop payé, négatif ==> n'a pas assez payé
For xI = 1 To Nbre
Deltas(xI) = Montants(xI) - Equitable
Next xI
'le but est qu'après les transferts entre chacune des personnes le tableau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de deltas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de deltas() égale au MIN
Dim LeMin, PosLeMin
'somme à transférer
Dim SommeTrans As Long
'BOUCLE DEBUT
Do
'on recherche le MAX de deltas et le rang du dernier élément de deltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
'on recherche le Min de deltas et le rang du dernier élément de deltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
'PosLeMin doit donner des sous à PosLeMax mais combien?
'PosLeMin peut donner au plus -(deltas(PosLeMin))
'PosLeMax peut recevoir au plus (deltas(PosLeMax))
'la somme qui transite de PosLeMin vers PosLeMax est le minimum des deux (en valeur absolue)
'cette somme sera ajoutée à deltas(PosLeMin)
'cette somme sera retirée à deltas(PosLeMax)
'Condition de sortie: tous les deltas() sont nuls
If (LeMax = LeMin) And (LeMax = 0) Then Exit Do
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
Debug.Print Noms(PosLeMin) & " donné " & SommeTrans & " à " & Noms(PosLeMax)
Loop
'FIN de la BOUCLE
End Sub
Luc
"Tatanka" a écrit dans le message de news:%Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
Bonsoir,
Comment résoudre avec une macro le problème suivant ?
Quatre personnes nommées A, B, C et D donnent
respectivement 23$, 30$, 45$ et 2$ pour l'achat de
certains produits qui serviront à toutes ces personnes.
On décide alors de répartir équitablement le montant
total de 100$. Donc chaque personne aurait du payer 25$.
Question :
Qui doit combien à qui ?
Manuellement ça ne cause pas de difficultés même si le nombre
de personnes est plus grand que 4 et le total différent de 100.
Dans ce cas-ci, A doit 2$ au groupe et D, 23$.
Solution :
A donne 2$ à B
D donne 3$ à B et 20$ à C.
Comment aborder ce problème avec une macro quand
n personnes fournissent chacune un certain montant
et qu'il faudra répartir le total équitablement ?
Avez-vous des suggestions ?
Serge
pour ton pb , on se moquerait bien d'envisager que qui doive devoir à q ui
l'essentiel est juste de savoir qui doit combien d'une part
dans l'exemple respectivement pour ceux qui on donné
2 et 23 soit A et D
on récupère donc 25$ au près de ceux là
ensuite plus qu'à répartir
donc à qui a donné plus, combien d'autre part
Bonsour® Misange avec ferveur ;o))) vous nous disiez :La vraie question c'est comment ramener tout le monde à 0 : qui donne
combien à qui de façon à minimiser le nombre de transfert de sous
entre les participants.
;o)))
la solution en effet : "*minimiser le nombre de transfert entre participan ts*"
consiste bien comme au casino à passer par un banquier qui encaisse et
redistribue
pour ton pb , on se moquerait bien d'envisager que qui doive devoir à q ui
l'essentiel est juste de savoir qui doit combien d'une part
dans l'exemple respectivement pour ceux qui on donné
2 et 23 soit A et D
on récupère donc 25$ au près de ceux là
ensuite plus qu'à répartir
donc à qui a donné plus, combien d'autre part
Bonsour® Misange avec ferveur ;o))) vous nous disiez :
La vraie question c'est comment ramener tout le monde à 0 : qui donne
combien à qui de façon à minimiser le nombre de transfert de sous
entre les participants.
;o)))
la solution en effet : "*minimiser le nombre de transfert entre participan ts*"
consiste bien comme au casino à passer par un banquier qui encaisse et
redistribue
pour ton pb , on se moquerait bien d'envisager que qui doive devoir à q ui
l'essentiel est juste de savoir qui doit combien d'une part
dans l'exemple respectivement pour ceux qui on donné
2 et 23 soit A et D
on récupère donc 25$ au près de ceux là
ensuite plus qu'à répartir
donc à qui a donné plus, combien d'autre part
Bonsour® Misange avec ferveur ;o))) vous nous disiez :La vraie question c'est comment ramener tout le monde à 0 : qui donne
combien à qui de façon à minimiser le nombre de transfert de sous
entre les participants.
;o)))
la solution en effet : "*minimiser le nombre de transfert entre participan ts*"
consiste bien comme au casino à passer par un banquier qui encaisse et
redistribue
