'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]")

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

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