Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Répartion équitable des dépenses

Répartion équitable des dépenses

32 réponses
Avatar
Tatanka
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3 4
Avatar
lSteph
Bonjour Serge,

Alors je m'incline.. .
je croyais qu'il s'agissait d'un éléphant pour accoucher d'une
souris !
Je m'étais trompé, ce serait juste pour une cerise, alors pourquoi pas
en effet la servir sur une pièce montée.

Le seul fait d'aimer la patisserie vaut bien cela ...
;o))

@+

lSteph


On 25 fév, 14:01, "Tatanka" wrote:
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.


Et en entrant les résultats du partage en A1:Ax,
ta macro deviendrait :

Public Sub Qui_Donne_A_Qui()
Dim Noms()
Dim Montants()
Dim Deltas()
Dim n As Integer
Dim Equitable As Long
Dim Total
Dim xI As Integer
Dim k As Integer
Dim s As Range
Dim i As Integer
Set s = Selection
n = s.Rows.Count
ReDim Noms(1 To n)
ReDim Montants(1 To n)
ReDim Deltas(1 To n)
For i = 1 To n
Noms(i) = s(i, 1)
Montants(i) = s(i, 2)
Deltas(i) = 0
Next i
Total = 0
For xI = 1 To n
Total = Total + Montants(xI)
Next xI
Equitable = Total / n
For xI = 1 To n
Deltas(xI) = Montants(xI) - Equitable
Next xI
Dim LeMax, PosLeMax
Dim LeMin, PosLeMin
Dim SommeTrans As Long
Do
LeMax = Deltas(1)
For xI = 2 To n: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): N ext xI
PosLeMax = 1
For xI = 2 To n: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): N ext xI
LeMin = Deltas(1)
For xI = 2 To n: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): N ext xI
PosLeMin = 1
For xI = 2 To n: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): N ext xI
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
k = k + 1
Cells(k, 1) = Noms(PosLeMin) & " donne " & SommeTrans & " à " & Noms(P osLeMax)
Loop
End Sub

Serge

"Tatanka" a écrit dans le message de new s:

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 n ews:
Bonsoir,

Une méthode en utilisant les plus grandes différences entre ceux qu i 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 mont ant é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", "Monseigneu r", "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 ta bleau deltas soit tout à zéro
'recherche du MAX de deltas() et le rang du dernier élément de del tas() égale au MAX
Dim LeMax, PosLeMax
'recherche du Min de deltas() et le rang du dernier élément de de ltas() é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 d eltas égale au MAX
LeMax = Deltas(1)
For xI = 2 To Nbre: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeM ax): Next xI
PosLeMax = 1
For xI = 2 To Nbre: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeM ax): Next xI

'on recherche le Min de deltas et le rang du dernier élément de d eltas égale au MIN
LeMin = Deltas(1)
For xI = 2 To Nbre: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeM in): Next xI
PosLeMin = 1
For xI = 2 To Nbre: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeM in): 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 deu x (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)), Ab s(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 den ews:%
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








Avatar
Mgr Banni
Pounet, c'est ainsi que tu me traites alors que je te tends la main pour que
tu la baises?
allez, casse-toi, pauvre c..
:-)))))) tout aussi évidemment
Mgr T.B.

"Pounet95" a écrit dans le message de news:


€A unité = autre ( avec entre autre, en pensant à Mr T ( pardon Msg
T?Banni ;;; ) quelques Navets ou Pommes de Terre ! )


Avatar
Misange
Bonjour Serge,

Alors je m'incline.. .
je croyais qu'il s'agissait d'un éléphant pour accoucher d'une
souris !
Je m'étais trompé, ce serait juste pour une cerise, alors pourquoi pas
en effet la servir sur une pièce montée.

Pas tout à fait Steph pas tout à fait.

Bien sur que si tu veux répartir les frais des vacances entre des
participants, le plus simple c'est qu'il y en ait un qui fasse le
banquier. Mais au labo par exemple, on peut pas faire ça : on a des
comptes par équipe. On passe notre temps à se prêter de l'argent en
fonction des arrivées de crédit de chaque équipe et pour se rembourser,
nous n'avons pas la possibilité de passer par un compte banquier dans
notre système de compta. On doit faire des transferts de compte à compte
seulement. Donc une solution telle que proposée est tout à fait
intéressante et est un peu plus que la cerise sur le gateau ;-). Y a
juste un niveau de complexité supplémentaire à gérer : on ne contribue
pas tous au même niveau, c'est fonction de la taille des équipes. reste
plus qu'à pondérer ce qui ne pose pas vraiment de problème.

--
Misange migrateuse
XlWiki : Participez à un travail collaboratif sur excel !
http://xlwiki.free.fr/wiki
http://www.excelabo.net

Avatar
Tatanka
Moi dire :
« Sans Char Abeuh, on serait encore dans le champ ».

Serge, qui a retrouvé sa bonne humeur.


"Pounet95" a écrit dans le message de news:
Bonjour à toutes et tous,

En fonction de tout ce qui vient d'être écrit qu'elle est la répartition de ce qu'aurait pu
être monnayés en fonction de leur apport ( en $B,£M,?A) les contributeurs à la réponse au problème ?
;o)))) évidemment !

nota :
$B unité = bisou
£M unité = merci
?A unité = autre ( avec entre autre, en pensant à Mr T ( pardon Msg T?Banni ;;; ) quelques Navets ou Pommes de Terre ! )

Pounet95

"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










Avatar
Pounet95
...... c comme chrétien, oeuf corse sinon tu ne serais pas Mgr !

Pounet95

"Mgr Banni" a écrit dans le message de
news:%
Pounet, c'est ainsi que tu me traites alors que je te tends la main pour
que tu la baises?
allez, casse-toi, pauvre c..
:-)))))) tout aussi évidemment
Mgr T.B.

"Pounet95" a écrit dans le message de news:


€A unité = autre ( avec entre autre, en pensant à Mr T ( pardon Msg
T?Banni ;;; ) quelques Navets ou Pommes de Terre ! )





Avatar
Tatanka
Salut Stéphane,

Ouais mais deux nouveaux problèmes surgissent :
1) Si Equitable n'est pas un nombre entier.
2) Si certains montants sont entrés avec 2 décimales.

Serge


"lSteph" a écrit dans le message de news:

Bonjour Serge,

Alors je m'incline.. .
je croyais qu'il s'agissait d'un éléphant pour accoucher d'une
souris !
Je m'étais trompé, ce serait juste pour une cerise, alors pourquoi pas
en effet la servir sur une pièce montée.

Le seul fait d'aimer la patisserie vaut bien cela ...
;o))

@+

lSteph


On 25 fév, 14:01, "Tatanka" wrote:
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.


Et en entrant les résultats du partage en A1:Ax,
ta macro deviendrait :

Public Sub Qui_Donne_A_Qui()
Dim Noms()
Dim Montants()
Dim Deltas()
Dim n As Integer
Dim Equitable As Long
Dim Total
Dim xI As Integer
Dim k As Integer
Dim s As Range
Dim i As Integer
Set s = Selection
n = s.Rows.Count
ReDim Noms(1 To n)
ReDim Montants(1 To n)
ReDim Deltas(1 To n)
For i = 1 To n
Noms(i) = s(i, 1)
Montants(i) = s(i, 2)
Deltas(i) = 0
Next i
Total = 0
For xI = 1 To n
Total = Total + Montants(xI)
Next xI
Equitable = Total / n
For xI = 1 To n
Deltas(xI) = Montants(xI) - Equitable
Next xI
Dim LeMax, PosLeMax
Dim LeMin, PosLeMin
Dim SommeTrans As Long
Do
LeMax = Deltas(1)
For xI = 2 To n: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To n: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
LeMin = Deltas(1)
For xI = 2 To n: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To n: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
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
k = k + 1
Cells(k, 1) = Noms(PosLeMin) & " donne " & SommeTrans & " à " & Noms(PosLeMax)
Loop
End Sub

Serge

"Tatanka" a écrit dans le message de news:

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 denews:%
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








Avatar
Char Abeuh
Bonsoir,

1) je m'en suis aperçu mais trop tard juste après l'envoi

Va falloir ressortir la charrue pour approfondir le sillon (dès que la pluie
aura cessé...)

Char Abeuh


"Tatanka" a écrit dans le message de
news:eGoK%
Salut Stéphane,

Ouais mais deux nouveaux problèmes surgissent :
1) Si Equitable n'est pas un nombre entier.
2) Si certains montants sont entrés avec 2 décimales.

Serge



Avatar
Modeste
Bonsour® Misange avec ferveur ;o))) vous nous disiez :

Y a juste un niveau de complexité supplémentaire à gérer
: on ne contribue pas tous au même niveau, c'est fonction de la
taille des équipes. reste plus qu'à pondérer ce qui ne pose pas
vraiment de problème.


dans ce cas le probleme n'est plus le même !!!!
si l'on connait la pondération
seule alors varie la quote-part élémentaire (cout total / nombre pondéré des
payants)
c'est le cas d'un groupe qui va au resto ou en excursion ou l'on fait tronc
commun
la pondération correspond au status de chaque payeur :
- Single pondération 1
- couple seul pondération 2
- couple avec invités(enfants ou amis) pondération 2+x

on peut compliquer en disant demi-tarif pour les enfants
;o)))

cela peut aussi etre alors le cas du labo
- des equipes avec X collaborateurs eventuellement Y stagiaires ou intermitents
- ou encore répartition des frais d'energie (par services nombre de becs de gaz
ou etuves)
;o)))

nous avions essayé à une époque la répartition des frais de cafetières ;o)))
certains prenaient x fois par jours, d'autre utilisaient des tasses, d'autres
des mugs, verres etc...
certains mettaient un sucre, d'autres pas , certains en mettaient même
plusieurs.
certains offraient le café à leurs visiteurs
d'autres sous prétexte "pseudo-médicaux" ;o))) changaient leurs habitudes et
fréquences
il fallut même à une époque intégrer le Thé ...


plusieurs s'y étaient collé :
- gestions avec des fiches sur un tableau, à la craie sur un tableau, avec Excel
(devinez qui ??), ouverture dans des créneaux horaires fixes
tous ont abandonné...
au dela de 5 à 6 personnes cela devient ingérable
au profit de la machine à PIECES et de la société SODHEX......


--
--
@+
;o)))

Avatar
Mgr Banni
heu...Sodexho, plutôt, non?
Mgr T.B. (dont les machines à pièces ne rapportent plus grand'chose)


"Modeste" a écrit dans le message de news:
ubYjNH$

au profit de la machine à PIECES et de la société SODHEX......


Avatar
Tatanka
Ave Char Abeuh,

J'ai un peu labouré et comme ceci, ça semble correct
à plus ou moins 0,01 :

Public Sub Qui_Donne_A_Qui()
Dim Noms()
Dim Montants() As Single
Dim Deltas() As Single
Dim n As Integer
Dim Equitable As Single
Dim Total As Single
Dim xI As Integer
Dim k As Integer
Dim s As Range
Dim i As Integer
Set s = Selection
n = s.Rows.Count
ReDim Noms(1 To n)
ReDim Montants(1 To n)
ReDim Deltas(1 To n)
For i = 1 To n
Noms(i) = s(i, 1)
Montants(i) = s(i, 2)
Deltas(i) = 0
Next i
Total = 0
For xI = 1 To n
Total = Total + Montants(xI)
Next xI
Equitable = Total / n
For xI = 1 To n
Deltas(xI) = Montants(xI) - Equitable
Next xI
Dim LeMax, PosLeMax
Dim LeMin, PosLeMin
Dim SommeTrans As Single
Do
LeMax = Deltas(1)
For xI = 2 To n: LeMax = IIf(Deltas(xI) > LeMax, Deltas(xI), LeMax): Next xI
PosLeMax = 1
For xI = 2 To n: PosLeMax = IIf(Deltas(xI) = LeMax, xI, PosLeMax): Next xI
LeMin = Deltas(1)
For xI = 2 To n: LeMin = IIf(Deltas(xI) < LeMin, Deltas(xI), LeMin): Next xI
PosLeMin = 1
For xI = 2 To n: PosLeMin = IIf(Deltas(xI) = LeMin, xI, PosLeMin): Next xI
SommeTrans = IIf(Abs(Deltas(PosLeMin)) <= Abs(Deltas(PosLeMax)), _
Abs(Deltas(PosLeMin)), Abs(Deltas(PosLeMax)))
Deltas(PosLeMin) = Deltas(PosLeMin) + SommeTrans
Deltas(PosLeMax) = Deltas(PosLeMax) - SommeTrans
If SommeTrans = 0 Then Exit Sub
k = k + 1
Cells(k, 1) = Noms(PosLeMin) & " donne " & Format(SommeTrans, "0.00") _
& " à " & Noms(PosLeMax)
Loop
End Sub

Serge



"Char Abeuh" a écrit dans le message de news: %236lo6t$
Bonsoir,

1) je m'en suis aperçu mais trop tard juste après l'envoi

Va falloir ressortir la charrue pour approfondir le sillon (dès que la pluie aura cessé...)

Char Abeuh


"Tatanka" a écrit dans le message de news:eGoK%
Salut Stéphane,

Ouais mais deux nouveaux problèmes surgissent :
1) Si Equitable n'est pas un nombre entier.
2) Si certains montants sont entrés avec 2 décimales.

Serge






1 2 3 4