Microsoft 365 Combinaisons d'objets

[SebastienN]

Bonjour à tous,

Merci de m'accueillir sur ce forum. J'ai besoin d'aide dans la création d'un tableau.

On a n objets (notés O1, O2... On) distincts répartis en p groupes (notés G1, G2... Gp) distincts. Un objet appartient à un et un seul groupe. Chaque groupe comporte donc entre 0 et n objets : si l'on note q1, q2... qp le nombre d'objets de chaque groupe, on a q1+q2+...=n.

Une feuille 1 comporte un tableau avec n colonnes (une colonne par objet) et 3 lignes :
- ligne 1 : nom de l'objet (O1 ou O2 ou ...)
- ligne 2 : groupe de l'objet (G1 ou G2 ou ...)
- ligne 3 : prix de l'objet

On cherche à créer dans la feuille 2 un tableau listant de façon automatique à partir de la feuille 1 toutes les combinaisons possibles d'objets, en excluant celles comportant au moins deux objets d'un même groupe : il ne peut y avoir dans une combinaison que 0 ou 1 objet d'un même groupe. On peut démontrer que le nombre de combinaisons possibles est égal à (q1+1)*(q2+1)*...

Le but du tableau est d'indiquer, pour chaque combinaison, la somme des prix des objets figurant dans la combinaison.

Je ne réussis pas à construire les formules du tableau de la feuille 2. Je souhaite par ailleurs réaliser un tableau sans macro, car je ne maîtrise pas du tout cet outil et car le problème ci-dessus fait partie d'un problème de combinaisons encore plus vaste que celui ici exposé.

Voici une illustration du résultat souhaité :

Hypothèses :
1) 4 objets : O1, O2, O3, O4 (n=4)
2) 3 groupes (q=3) :
- G1 avec O1, O2 et O3 (q1=3 éléments)
- G2 avec O4 (q2=1 élément)
- G3 vide (q3=0 élément)
3) Prix des objets : O1=1€,O2=10€,O3=100€,O4=1000€

Nombre de combinaisons possibles : (3+1)*(1+1)*(0+1)=4*2*1=8

- Combinaison 1 : aucun objet ; somme des prix = 0€
- Combinaison 2 : O1 ; somme des prix = 1€
- Combinaison 3 : O1,O4 ; somme des prix = 1001€
- Combinaison 4 : O2 ; somme des prix = 10€
- Combinaison 5 : O2,O4 ; somme des prix = 1010€
- Combinaison 6 : O3 ; somme des prix = 100€
- Combinaison 7 : O3,O4 ; somme des prix = 1100€
- Combinaison 8 : O4 ; somme des prix = 1000€

Voici le fichier Excel complémentaire à ma demande : https://www.cjoint.com/c/JDbi4DEGbNl

Un grand merci à ceux qui pourraient m'aider!

 

[laurent3372]

Un classeur exemple serait le bienvenu,

Cheers,
--
LR

 

[SebastienN]

Bonjour,

Voici le fichier Excel complémentaire à ma demande : https://www.cjoint.com/c/JDbi4DEGbNl

 

[Hasco]

Bonjour,

Et le joindre directement sur le forum pour que les futurs demandeurs puissent le trouver ? Sur ci-joint d'ici quelques temps il sera perdu pour tous.

Sur xld il sera gardé au chaud pour occuper les futures nuits d'hiver des assoiffés de combinaison.

Bonne journée

 

[SebastienN]

Bonjour,

Voici le fichier joint directement dans le message.

 

[mapomme]

Bonsoir @SebastienN, bienvenue sur XLD ,
Bonsoit @laurent3372 , @Roblochon

Dans le fichier joint, une tentative, en recyclant une ancienne procédure de mon cru pour trouver toutes les combinaisons de p parmi n.

• Le code est dans module1
• La feuille des données initiales s'appelle Data
• J'ai réorganisé les données initiales comme sur l’image ci-dessous
  
• La feuille des données s'appelle Result
• Les trois cellules A1 à C1 de la feuille "Result" ne doivent pas être supprimées. Le format de la cellule C1 détermine le format des cellules qui suivent C1 en ligne 1.
  
• La macro se lance en cliquant sur le bouton Hop!

Attention! En augmentant le nombre d'objet et le nombre de groupe, le nombre de combinaison croit de manière exponentielle. On va se retrouver très vite confronté à des temps d'exécution très longs et/ou des dépassements de capacité.

Le code dans module1:

Option Explicit

Sub BiduleEtGroupe()
Dim tdata, t, tMax(), tRes
Dim i&, j&, k&, ng&, nBidMax&

'-----------------------------------  acquisition des données
With Sheets("data")
   If .FilterMode Then .ShowAllData
   tdata = .Range("a1").CurrentRegion.Formula
   With .Range("a1").CurrentRegion
      .Sort key1:=.Range("b1"), order1:=xlAscending, key2:=.Range("a1"), order2:=xlAscending, Header:=xlYes
      t = .Value
      .Value = tdata
   End With
End With

'-----------------------------------  tableau des groupes et de leurs bidules
'nombre de groupe avec pour chaque groupe son nombre de bidule
k = 0: j = 0
For i = 2 To UBound(t)
   If t(i, 2) <> t(i - 1, 2) Then
      k = k + 1
      ReDim Preserve tMax(1 To k)
      tMax(k) = 1    ' pour tenir compte d'une absence de bidule dans le groupe
   End If
   tMax(k) = tMax(k) + 1
Next i
ng = UBound(tMax)

'stockage du nom des groupes avec les noms des bidules associés
'stockage du nom des groupes avec les prix des bidules associés

For i = 1 To ng: nBidMax = IIf(tMax(i) > nBidMax, tMax(i), nBidMax): Next
ReDim nombid(1 To k, 1 To nBidMax + 1)
ReDim prixbid(1 To k, 1 To nBidMax + 1)
k = 0
For i = 2 To UBound(t)
   If t(i, 2) <> t(i - 1, 2) Then
      k = k + 1
      nombid(k, 1) = t(i, 2)
      prixbid(k, 1) = t(i, 2)
      nombid(k, 2) = t(i, 1)
      prixbid(k, 2) = t(i, 3)
      j = 2
   Else
      j = j + 1
      nombid(k, j) = t(i, 1)
      prixbid(k, j) = t(i, 3)
   End If
Next i

'toutes les combinaisons
tRes = TableauCombi(tMax)

'Affichage
With Sheets("Result")
   .Activate
   If .FilterMode Then .ShowAllData
   .UsedRange.Offset(1).Clear
   .Range("c1").Resize(, .Columns.Count - 2).ClearContents
   .Range("d1").Resize(, .Columns.Count - 3).Clear
   .Range("a2").Resize(UBound(tRes)).FormulaR1C1 = "=ROW()-1"
   .Range("a2").Resize(UBound(tRes)).Value = .Range("a2").Resize(UBound(tRes)).Value
   .Range("c1").Copy
   .Range("c1").Resize(, ng).PasteSpecial xlPasteFormats
   For i = 1 To UBound(nombid): Cells(1, 2 + i) = nombid(i, 1): Next
   'remplacer par les noms des objets et calculer le prix
   ReDim prix(1 To UBound(tRes), 1 To 1) As Currency
   For i = 1 To UBound(tRes)
      For j = 1 To ng
         prix(i, 1) = prix(i, 1) + prixbid(j, tRes(i, j) + 1)
         tRes(i, j) = nombid(j, tRes(i, j) + 1)
      Next j
   Next i
   .Range("c2").Resize(UBound(tRes), UBound(tRes, 2)) = tRes
   .Range("b2").Resize(UBound(tRes), 1) = prix
   .Range("a1").CurrentRegion.Borders.LineStyle = xlContinuous
   .Range("b2").Resize(UBound(tRes)).Style = "Currency"
   .Range("a2").Resize(UBound(tRes)).HorizontalAlignment = xlCenter
   .Range("a1").CurrentRegion.EntireColumn.AutoFit
End With
End Sub

Function TableauCombi(tm)
Dim p&, maxElem&, i&, nres&, Inc&

   'initialisation
   p = UBound(tm)    'nombre de Groupe
   maxElem = 1: For i = 1 To p: maxElem = maxElem * tm(i): Next 'nombre de combinaisons au final
   ReDim Combi(1 To p)    'tableau de la combinaison en cours d'édition
   ReDim res(1 To maxElem, 1 To p) 'tableau de toutes les combinaisons
   'la première combinaison est (1, 1 , 1, ... , 1)
   For i = 1 To p: Combi(i) = 1: Next
   'stockage de la première combinaison
   nres = nres + 1: For i = 1 To p: res(nres, i) = Combi(i): Next
   'boucle pour les autres combi
   Inc = p     'la colonne à incrémenter est la dernière
   Do
      If Combi(Inc) + 1 > tm(Inc) Then
         'si l'élément de combi en colonne Inc incrémenté de 1
         'dépasse le maximun autorisé, on décrémente Inc
         Inc = Inc - 1
         'si Inc arrive à zéro, on est à la fin de la boucle
         If Inc = 0 Then Exit Do
      Else
         'si l'élément de combi en colonne Inc incrémenté de 1
         'ne dépasse pas le maximun autorisé, on incrémente cet élément
         Combi(Inc) = Combi(Inc) + 1
         'les éléments suivants sont chacun égaux à 1
         For i = Inc + 1 To p: Combi(i) = 1: Next
         'on stocke la nouvelle combinaison
         nres = nres + 1: For i = 1 To p: res(nres, i) = Combi(i): Next
         Inc = p
      End If
   Loop
   TableauCombi = res
End Function

 

[laurent3372]

Voici une solution sans macro, uniquement avec des formules
Pour limiter la longueur des formules, j'ai introduit deux feuilles de travail: Work et Combinaisons.
J'ai prévu le code pour pouvoir traiter un maximum de 10 groupes et 999 combinaisons.
Le nombre d'objets par groupe n'est pas limité.

 

[SebastienN]

Un grand merci @mapomme et @laurent3372 pour vos réponses !

@mapomme : Ton fichier fonctionne parfaitement. Je recherche une solution sans macro, mais la tienne pourra éventuellement me servir lorsque je maîtriserai cet outil (je n'ai présenté ici qu'une partie de mon problème et je vais devoir intégrer la solution partielle recherchée ici à un problème de combinaisons plus vaste). Ta solution pourra aussi bien sûr servir à d'autres personnes qui un jour feront la même recherche que moi. Merci.

@laurent3372 : Ton fichier correspond exactement à ce que je recherche. J'ai relevé un petit problème lié à la fonction TROUVE que tu as utilisée : si 2 produits ont des noms tels que le nom de l'un est inclus dans le nom de l'autre (par exemple O1 et O10, on retrouve l'ensemble de caractères "O1" dans "O10"), et que le nom inclus est inscrit dans la feuille "Data" après (à droite de) celui dans lequel il est inclus (par exemple "O10" puis, plus à droite, "O1"), alors certaines combinaisons sont identiques, tandis que d'autres n'apparaissent pas. J'ai fait le test en remplaçant dans ton fichier (feuille "Data") O1 par O10 et O4 par O1 : les 2 premières combinaisons sont identiques, ou plus exactement, le prix calculé est le même.