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

[Rémi Delattre]

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 !

 

[mapomme]

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 :

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

 

[Rémi Delattre]

Merci beaucoup pour cette réponse détaillée. Je vais regarder dans le détail et tenter de comprendre comment ça fonctionne, c'est la première fois que je vois du VBA !

 

[mapomme]

c'est la première fois que je vois du VBA !

Re,

Ça risque d'être un peu difficile à appréhender si vous n'avez jamais touché au VBA.
Mais il faut un début à tout.
Bon, on va aller déjeuner .