Regrouper nombre de 2 liste

[kenzo1245]

Bonjour,

C'est assez compliqué à expliquer.

Alors voilà, j'ai 2 liste de nombre en colonnes qui peuvent varier mais qui auront toujours la même somme.

ex:

liste A : 15; 15 ; 50 ; 50 ; 50 ; 100 ; 100 ; 100
liste B : 40; 40 ; 100 ; 100 ; 100 ; 100

J'aimerais savoir si on peut regrouper à chaque fois qu'il y à la même valeur ou la même somme dans chacune des 2 listes et les mettre dans d'autre colonnes séparément. (peut-être avec VBA).

Dans l'exemple ci-dessus ça donnerai : (15;15;50 avec 40;40) (50;50 avec 100) (100 avec 100) (100 avec 100) (100 avec 100)

J'ai mis un document pour une meilleur explication.

Merci d'avance

 

[Dranreb]

Re : Regrouper nombre de 2 liste

Bonjour.

Avec une fonction matricielle perso :

Option Explicit

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
' On Error GoTo Err
Do
   Do
      Le1 = Le1 + 1: If Le1 > UBound(Lst1) Then GoTo Fin
      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
   Do
      Le2 = Le2 + 1: If Le2 > UBound(Lst2) Then GoTo Fin
      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
' Err: MsgBox Err.Description: Stop: Resume
Fin: RegroupListes = Résu
End Function

En H6:W14, validé matriciellement (Ctrl+Maj+Entrée) :

=RegroupListes($B$6:$B$12;$E$6:$E$12)

Remarque: Résultat imprévisible si le total final ne correspond pas.

 

[AL1976]

Re : Regrouper nombre de 2 liste

bonsoir,
est-ce que le fichier joint peut t'ètre utile ?
il fait les regroupements que tu souhaites en colonnes M et N, mais d'une façon différente.
cdlmt,
AL

 

[Dranreb]

Re : Regrouper nombre de 2 liste

Une révision de ma fonction qui explore les deux listes jusqu'au bout même si on arrive au terme de l'une sans trouver d'égalité :

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

 

[kenzo1245]

Re : Regrouper nombre de 2 liste

Merci à tous..

Comment faire pour relier le code vba à la formule matricielle? je sais je suis nul..

Salutations !