¿Cómo distribuir los gastos (quién debe dinero a quién)? El problema no es tan sencillo de solucionar pero el siguiente programa VBA te permitirá solucionarlo.
Resumen del problema
La siguiente tabla presenta los gastos en que incurren los miembros de una asociación para organizar un viaje. Los gastos fueron gasolina, peaje, aparcamiento,... todos ellos gastos difíciles de dividir. Ahora bien, ¿cómo calcular la distribución de gastos a posteriori?
Insertar datos en una tabla
Para simplificar el código VBA, es esencial insertar datos en una tabla (Insertar > Tabla)
E instantáneamente sus datos estarán en una tabla colorida. El color se utiliza para identificar el límite de sus datos (pero el color se puede cambiar).
Cambiar el nombre de la Tabla
La ventaja de trabajar con una Tabla en un programa VBA es que puedes consultar su nombre muy fácilmente. Entonces, independientemente de su posición (fila y columna) en el libro de trabajo, ¿el programa VBA siempre encontrará los datos?
En el programa le dimos el nombre. tbl_Expenso a nuestra mesa (Creación de tabla > Nombre de tabla)
Como veremos en el código VBA, darle un nombre específico a la tabla y a las columnas facilitará la “lectura” de los datos.
IMPORTANTE mantener el nombre de la Tabla y también LAS COLUMNAS como se muestra en el siguiente código
'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]")código completo
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 SubPrincipio de la lógica del código.
Todo el principio de cálculo se basa en el promedio general..
QuotePart = Application.WorksheetFunction.Average(Range("tbl_Depense[Somme payée]"))A partir del promedio, es fácil saber quiénes deben dinero (por debajo del promedio) y quiénes deberían recibir dinero (por encima del promedio). Al finalizar la ejecución de la macro VBA, tenemos el siguiente resultado final
Cómo depurar un programa VBA
Si tiene dificultades para encontrar el origen de sus errores en VBA, esta guía le explicará cómo utilizar el depurador.
Control del resultado
Para saber quién debe cuánto, es muy fácil crear una función SUMAR.SI para personas que deben dinero a varias personas.
