Function RegroupListes(PlgLst1 As Range, Plglst2 As Range) As Variant()
Dim Lst1(), Le1 As Long, Ls1 As Long, S1 As Double, Résu(1 To 9, 1 To 16), _
Lst2(), Le2 As Long, Ls2 As Long, S2 As Double, C As Long
Lst1 = PlgLst1.Value
Lst2 = Plglst2.Value
For Ls1 = 1 To 9: For C = 1 To 16: Résu(Ls1, C) = "": Next C, Ls1: Ls1 = 0: C = 0
Do
Do
Le1 = Le1 + 1: If Le1 > UBound(Lst1) Then Exit Do
Ls1 = Ls1 + 1: Résu(Ls1, C + 1) = Lst1(Le1, 1)
S1 = S1 + Lst1(Le1, 1): Loop Until S1 >= S2
If S1 = S2 Then C = C + 2: Ls1 = 0: Ls2 = 0
If Le1 > UBound(Lst1) And Le2 > UBound(Lst2) Then Exit Do
Do
Le2 = Le2 + 1: If Le2 > UBound(Lst2) Then Exit Do
Ls2 = Ls2 + 1: Résu(Ls2, C + 2) = Lst2(Le2, 1):
S2 = S2 + Lst2(Le2, 1): Loop Until S2 >= S1
If S1 = S2 Then C = C + 2: Ls1 = 0: Ls2 = 0
Loop Until Le1 > UBound(Lst1) And Le2 > UBound(Lst2)
If S2 <> S1 Then Résu(9, C + IIf(S2 > S1, 1, 2)) = "(+" & Abs(S2 - S1) & " ?)"
RegroupListes = Résu
End Function