Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Problème de répartition - Solver ?

Rémi Delattre

XLDnaute Nouveau
Bonjour,

Je cherche à résoudre le problème suivant :
- Des individus appartenant à des groupes disposent d'une quantité d'argent qui peut être négative ou positive
- Ils cherchent à répartir cet argent de façon à diminuer le déficit total du groupe au terme de la répartition.
- Les individus qui possèdent plus que 0 peuvent donner à ceux qui possèdent moins de 0 dans la limite de leur capital, mais ils refusent de s'endetter eux-mêmes.
- L'individu le plus excédentaire donne à celui qui est le plus endetté, puis au deuxième plus endetté, jusqu'à ce que la dette disparaisse. Si l'intervention de l'individu le plus excédentaire ne suffit pas, le deuxième prend le relais.
- Si, au terme de la répartition, tout l'argent excédentaire n'a pas été utilisé pour combler les besoins des individus endettés, il est conservé par son/ses détenteurs initiaux.
- Le groupe peut être composé d'un nombre d'individus très variable. Il peut être déficitaire dans son ensemble ou excédentaire dans son ensemble.
- Au terme du calcul, si l'argent d'un individu était initialement positif, il ne peut pas être supérieur. Cette contrainte n'a aucun sens pratique mais elle est importante.

Pour l'instant, j'ai entrepris :
- Une approche à base de MOYENNE.SI, SOMME.SI parmi les groupes. Le problème est que j'arrive à faire diminuer le déficit mais pas le capital de ceux qui prêtent.
- Une approche fondée sur le rang des individus parmi les prêteurs, avec l'idée que celui qui prête le plus récupère le plus si le groupe est excédentaire. Je n'ai pas réussi à l'automatiser.

En passant par des formules classiques, je constate qu'il est difficile d'éviter les références circulaires ou d'automatiser pour prendre en compte la variabilité des situations. Ce cas pourrait relever du Solver, mais je ne maîtrise pas son usage.

Pour clarifier, je vous transmet un fichier avec le résultat que je souhaiterais obtenir dans trois configurations assez différentes. Je suis au fait de la difficulté du problème et je suis preneur de toutes vos suggestions !
 

Pièces jointes

  • expb2.xlsx
    10.9 KB · Affichages: 7

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Rémi Delattre ,

Par formule, cela me semble un peu compliqué. Pour le solver, cela me semble aussi un peu compliqué.
Voici une version en VBA. La procédure est dans module1.
Cliquer sur le bouton HOP!.
(j'ai transformé votre tableau en source en tableau structuré).

Le code dans module1 :
VB:
Sub JeTeDonne()
Dim ts As ListObject, t, i&, m&
   Application.ScreenUpdating = False
   Sheets("FEUIL1").Columns("b:c").Insert
   Set ts = Sheets("FEUIL1").Range("a1").ListObject
   With ts.Range
      t = ts.DataBodyRange
      For i = 1 To UBound(t): t(i, 2) = i: t(i, 3) = IIf(t(i, 5) < 0, -1, 1): t(i, 5) = Abs(t(i, 5)): Next
      ts.DataBodyRange = t
      .Sort key1:=.Cells(1, 4), order1:=xlAscending, key2:=.Cells(1, 3), order2:=xlDescending, _
      key3:=.Cells(1, 5), order3:=xlAscending, Header:=xlYes, MatchCase:=False
      t = ts.DataBodyRange
      For i = 1 To UBound(t): t(i, 5) = t(i, 3) * t(i, 5): Next
      ts.DataBodyRange = t
      For i = UBound(t) To 2 Step -1
         If t(i, 5) < 0 Then
            For m = i - 1 To 1 Step -1
               If t(m, 4) <> t(i, 4) Then Exit For
               If t(m, 5) > 0 Then
                  If Abs(t(i, 5)) <= t(m, 5) Then
                     t(m, 5) = t(m, 5) + t(i, 5)
                     t(i, 5) = 0
                  Else
                     t(i, 5) = t(i, 5) + t(m, 5)
                     t(m, 5) = 0
                  End If
               End If
            Next m
         End If
      Next i
      ts.DataBodyRange.Value = t
      .Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlYes, MatchCase:=False
      Sheets("FEUIL1").Columns("b:c").Delete
   End With
End Sub
 

Pièces jointes

  • Rémi Delattre- expb2- v1.xlsm
    20.6 KB · Affichages: 7

Discussions similaires

Réponses
8
Affichages
474
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…