Comment faire la répartition des dépenses (qui doit de l'argent à qui) ? Le problème n'est pas si simple à résoudre mais le programme VBA suivant va vous permettre de solutionner ce problème.

Présentation du problème

Le tableau suivant présente les dépenses engagées par les membres d'une association pour l'organisation d'un voyage. Les frais étaient l'essence, le péage, le parking, ... tous les frais qu'il est difficile de diviser. Maintenant, comment faire le calcul de répartition des dépenses après coup ?

Insérer les données dans un Tableau

Pour simplifier le code VBA, il est indispensable d'insérer les données dans un Tableau (Insertion > Tableau)

Et instantanément vos données sont dans un Tableau coloré. La couleur sert à identifier la limite de vos données (mais la couleur peut être changée).

Changer le nom du Tableau

L'avantage de travailler avec un Tableau dans un programme VBA, c'est que l'on peu faire référence à son nom très facilement. Ainsi, peu importe sa position (ligne et colonne) dans le classeur, le programme VBA saura toujours trouver les données ?

Dans le programme, nous avons donné le nom tbl_Depense à notre Tableau (Création de Tableau > Nom du Tableau)

Comme nous allons le voir dans le code VBA, le fait d'attribuer un nom précis au tableau et aux colonnes, va permettre de "lire" les données plus facilement.

IMPORTANT de conserver le nom du Tableau et aussi DES COLONNES comme le montre le bout de code suivant

'Récupérer les données dans le Tableau (avec le nom des colonnes)
    TbloNoms = Range("tbl_Depense[Nom]")
    TbloPaye = Range("tbl_Depense[Somme payée]")

Code complet

Option Explicit
Option Base 1 'l'index du premier élément des array est 1 (0 si cette option n'est pas précisée)

Sub PayezVosDettes()
Dim TbloNoms As Variant 'tableau participants
Dim TbloPaye As Variant 'tableau montant payé par chacun
Dim Nbre As Long        'Nombre de participants
Dim QuotePart As Double 'part de chacun dans les dépenses communes
Dim PosGrand As Long, PosPetit As Long     'Position du montant le plus grand et plus petit dans le tableau
Dim NomGrand As String  'Nom correspondant à GrandCredit
Dim NomPetit As String  'Nom correspondant à PetitDebit
Dim GrandEcart As Double, PetitEcart As Double 'Montant payé par le plus grand et le plus petit débiteur
Dim Apayer As Double
Dim Ecarts As Variant   'tableau des différences entre la somme payée et celle due
Dim i As Long
'Récupérer les données dans le Tableau (avec le nom des colonnes)
    TbloNoms = Range("tbl_Depense[Nom]")
    TbloPaye = Range("tbl_Depense[Somme payée]")
'vérification de cohérence
    If UBound(TbloNoms) <> UBound(TbloPaye) Then
        MsgBox ("Attention, il doit y avoir le même nombre d'éléments dans les colonnes noms et montant payé")
        Exit Sub
    End If
'Calcul de la moyenne (ou quote part)
    Nbre = UBound(TbloNoms)
    QuotePart = Application.WorksheetFunction.Average(Range("tbl_Depense[Somme payée]"))
'Calcul de ce que chacun doit payer (débit <0) ou recevoir (crédit >0)
    Nbre = UBound(TbloPaye)
    ReDim Ecarts(Nbre)
    For i = 1 To Nbre
        Ecarts(i) = TbloPaye(i, 1) - QuotePart
    Next i
'Titre tableau final
    Range("E" & Range("tbl_Depense[#All]").Row) = "doit"
    Range("F" & Range("tbl_Depense[#All]").Row) = "à"
'On va progressivement (dans une boucle) réduire à 0 tous les écarts.
'Condition de sortie: tous les écarts sont nuls ou la somme échangée est nulle
    i = 1
    Do
        'on recherche systématiquement la valeur la plus grande et la plus basse
        'GrandEcart= la plus forte différence par rapport à la quotepart
        'et PetitEcart = la plus petite différence par rapport à la quotepart
        GrandEcart = Application.Max(Ecarts)
        PetitEcart = Application.Min(Ecarts)
        'si les deux sont nulles alors le pb est résolu, on sort de la boucle
        If GrandEcart = PetitEcart And GrandEcart = 0 Then Exit Do
        ' Calcul du montant à payer (ça dépend du signe entre la valeur min et max)
        Apayer = IIf(GrandEcart + PetitEcart > 0, Abs(PetitEcart), Abs(GrandEcart))
        ' Si ce montant est null, toutes les dépenses ont été réparties et on quitte la boucle
        If Apayer = 0 Then Exit Do
        ' Position des valeurs les plus grandes et plus petites dans le tableau
        PosGrand = Application.Match(GrandEcart, Ecarts, 0) 'renvoie l'index de grandecart dans l'array ecarts
        PosPetit = Application.Match(PetitEcart, Ecarts, 0)
        'et à qui ces montants correspondent dans le TbloNoms
        NomGrand = TbloNoms(PosGrand, 1)
        NomPetit = TbloNoms(PosPetit, 1)
        'nomgrand peut recevoir au maximum ce que la communauté lui doit
        'nomPetit peut donner au maximum ce qu'il doit à la communauté
        'on modifie en conséquence le tableau des écarts
        Ecarts(PosGrand) = Ecarts(PosGrand) - Apayer
        Ecarts(PosPetit) = Ecarts(PosPetit) + Apayer
        'Afficher le résultat
        Range("D" & Range("tbl_Depense[#All]").Row + i) = TbloNoms(PosPetit, 1)
        Range("E" & Range("tbl_Depense[#All]").Row + i) = Round(Apayer, 2)
        Range("F" & Range("tbl_Depense[#All]").Row + i) = TbloNoms(PosGrand, 1)
        i = i + 1
    Loop

End Sub

Principe de la logique du code

Tout le principe du calcul est basé sur la moyenne globale.

QuotePart = Application.WorksheetFunction.Average(Range("tbl_Depense[Somme payée]"))

A partir de la moyenne, il est facile de savoir ceux qui doivent de l'argent (inférieur à la moyenne) et ceux qui doivent recevoir de l'argent (supérieur à la moyenne).

A la fin de l'exécution de la macro VBA, nous avons le résultat final suivant

Contrôle du résultat

Pour savoir qui doit combien, il est très facile de créer une fonction SOMME.SI.ENS pour les personnes qui doivent de l'argent à plusieurs personnes.

=SOMME.SI.ENS(E4:E10;D4:D10;D12) => 5,87