VBA

Répartition des dépenses – VBA

Temps de lecture 4 minutes

Comment faire la répartition des dépenses engagées entre tous les participants ? Voici le problème mathématique le plus important du monde 😉

Présentation du problème

Vous un groupe d'amis et tout le monde a engagé des dépenses pour la réalisation de votre projet. Maintenant qui doit combien et à qui ? Seul un programme VBA pourra nous aider a effectuer ce travail de répartition

Donnees de base a repartir

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)

Menu 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).

Insertion des donnees dans un Tableau

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 donner le nom tbl_Depense à notre Tableau (Création de Tableau > Nom du Tableau)

Inserer les donnees dans un Tableau et choisir son nom

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" &amp; Range("tbl_Depense[#All]").Row) = "doit"
    Range("F" &amp; 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" &amp; Range("tbl_Depense[#All]").Row + i) = TbloNoms(PosPetit, 1)
        Range("E" &amp; Range("tbl_Depense[#All]").Row + i) = Round(Apayer, 2)
        Range("F" &amp; 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

Repartition des depenses apres le traitement VBA

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

Total des sommes a verser pour un individu

Related posts

VBA – Changer la date et l’heure d’un fichier

Frédéric LE GUEN

VBA – Boite de dialogue « Fichier »

Frédéric LE GUEN

Numéro de semaine à partir d’une date

Frédéric LE GUEN

Laissez un commentaire

Ce site utilise Akismet pour réduire les indésirables. En savoir plus sur comment les données de vos commentaires sont utilisées.

Ce site utilise des cookies pour améliorer votre expérience et vos recherches. Nous pensons que vous êtes dʼaccord sur ce principe mais vous pouvez refuser cette option. Accepter Continuer

Privacy & Cookies Policy