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 SubPrincipe 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
Comment débugger un programme VBA
Si vous avez des difficultés à trouver l'origine de vos erreurs en VBA, ce guide va vous expliquer comment utiliser le débuger.
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.
