Microsoft 365 Trier / grouper par paquet dont la somme des éléments est 20

[guigol]

Bonsoir,

J'ai beau chercher, je ne trouve pas. Je ne dois pas utiliser les bons mots clés... Je me permets donc de poster ce message sur différents sites en esperant que l'un d'entre vous me guide vers la solution

J'ai une grande quantité de nombres.

j'aimerais les trier ou les regrouper par "paquet" dont la somme serait égal ou inférieur à 20.

Par exemple, j'ai les nombres suivants :

1 2 2 3 3 4 4 5 5 6 6 7 8 8 8 9

j'aimerais pouvoir les regrouper ainsi :

Autre exemple : si j'ai :

6 7 8 9

j'aimerais pouvoir les regrouper ainsi :

Auriez vous une idée pour faire cela?

Par avance, merci pour votre aide.

 

[chris]

Multipost...

 

[guigol]

Multipost...

Bonsoir @chris ,

En quoi est ce problématique de poser la question sur différents sites?

 

[chris]

Bonjour
L'usage est de le signaler

 

[guigol]

Bonjour
L'usage est de le signaler

Je corrige donc.

 

[mapomme]

Bonsoir @guigol , @chris ,

Un essai dans le fichier joint.

Les données sources sont en colonne A à partir de la cellule A1.
Les valeurs négatives ou strictement supérieures à la cible sont ignorées.

Trois paramètres sont à indiquer :

1. cellule D7 (nommée "Cible") qui contient la valeur cible
2. cellule D8 (nommée "MaxPaquet") qui contient le nombre d'élément maximum par paquet
3. cellule D9 (nommée "Itérations") qui contient le nombre de tentatives à faire pour chaque couple (Cible, MaxPaquet)

Une fois ces trois paramètres définis, cliquez sur le bouton Hop!
Les résultats s'affiche à partir de la colonne H. La colonne G contient la somme des éléments du paquet de la ligne.

Le code est dans le module de la feuille "Feuil1".

N.B. Comme la méthode est basée sur les nombre aléatoires, deux exécutions consécutives peuvent aboutir (et c'est le cas le plus fréquent) à des résultats différents.

Avertissement : la résolution de ce type de problème peut très vite devenir impossible à réaliser (temps d'exécution interminable et/ou dépassement des capacités de la machine) quand les valeurs de la cible, de MaxPaquets et du nombre d'éléments sources augmentent.

Option Explicit
Dim a()

Sub Essai()
Dim t, i&, deb, xcible&, xpas&

   deb = Timer
   'effacement des précédents résultats
   Range("h1").CurrentRegion.Clear

   'lecture des données
   t = Range(Cells(1, "a"), Cells(Rows.Count, "a").End(xlUp))
   ReDim a(0 To 0)
   For i = 1 To UBound(t)
      If t(i, 1) > 0 And t(i, 1) <= Range("Cible") Then
         ReDim Preserve a(0 To UBound(a) + 1)
         a(UBound(a)) = t(i, 1)
      End If
   Next i

   Randomize
   For xcible = Range("Cible") To 1 Step -1
      For xpas = Range("MaxPaquet") To 1 Step -1
         nTours xcible, xpas, Range("Itérations")
      Next xpas
   Next xcible

   'calcul des totaux
   i = Cells(Rows.Count, "h").End(xlUp).Row
   Range("g2:g" & i).FormulaR1C1 = "=SUM(RC[1]:RC[20])"
   Range("g2:g" & i).Font.Bold = True
   Range("g2:g" & i).Interior.Color = RGB(200, 200, 200)
   Range("g2").CurrentRegion.Borders.LineStyle = xlContinuous
   MsgBox "Durée = " & Format(Timer - deb, "#,##0.0\ sec.")
End Sub

Sub nTours(Cible, pas, nFois)
Dim i&
   For i = 1 To nFois
      UnTour Cible, pas
   Next i
End Sub

Sub UnTour(Cible, pas)
Dim i&, som&, j&, ligne&, n&, aux&, col&

For i = 1 To UBound(a)
   n = 1 + Int(Rnd * UBound(a))
   aux = a(i): a(i) = a(n): a(n) = aux
Next i
For i = 1 To Int(UBound(a) / pas)
   som = 0
   For j = 1 + pas * (i - 1) To 1 + pas * (i - 1) + (pas - 1): som = som + a(j): Next
   If som = Cible Then
      ligne = Cells(Rows.Count, "h").End(xlUp).Row + 1: col = Range("h1").Column
      For j = 1 + pas * (i - 1) To 1 + pas * (i - 1) + (pas - 1)
         Cells(ligne, col) = a(j)
         col = col + 1
         a(j) = ""
      Next j
   End If
Next i
compacter
End Sub

Sub compacter()
Dim i&, n&
   For i = 1 To UBound(a)
      If a(i) <> "" Then n = n + 1: a(n) = a(i)
   Next i
   ReDim Preserve a(0 To n)
End Sub

 

[guigol]

Super. Merci beaucoup.


C'est exactement cela.

 

[labombola46]

J'aimerais, si possible, faire une variation de la macro mapomme.
En A1: A10 j'ai
30
78
45
65
20
4
13
64
58
85
Cible a 95 ans
Max / Paquet a 3 ans
Itérations est de 2000
Voici, maintenant, la solution proposée
95 13 78 4
95 20 45 30
85 85
65 65
64 64
58 58
J'aimerais que mettre «5» dans la cible me donne le même résultat que les 2 premières solutions ou tous ces triplets qui dépassent 90 ou 180 dont le reste donnerait 5 ou un autre nombre entre 1 et 90. J'espère que vous comprenez la traduction avec Google

 

[mapomme]

Bonjour @labombola46 ,

J'avoue ne pas tout comprendre.

• Cible égale à 95 => je comprends.
• Max / Paquet est le maximum de nombres par paquet (ou ligne). Max / Paquet n'a donc pas d'unité. C'est 3 et non pas 3 ans.

Quand j’exécute la macro avec vos données, je retrouve vos résultats

La suite est plus incompréhensible pour moi. Pouvez-vous me montrer le résultat (les lignes) que vous souhaitez pour le résultat de la macro:

• en indiquant pour les lignes que vous désirez garder pourquoi vous les conservez
• en indiquant pour les lignes que vous désirez supprimer pourquoi vous les supprimez

En attendant votre réponse... ,

 

[mapomme]

Re @guigol,

Une version v2 qui cherche une meilleure optimisation pour le résultat final.

On a ajouté une cellule nommée "Optimisation" ( cellule D10 ) qui est le nombre de fois où on tente l'optimisation (équivalent des cliques sur le bouton Hop!).

Une solution est meilleure que la précédente si :

• le nombre de lignes dont la somme vaut cible est supérieur à celui de la précédente solution
• ou bien le nombre de lignes dont la somme vaut cible est égal à la précédente solution et l'écart-type des toutes les lignes est inférieur à l'écart-type de la précédente solution.

Le temps d'exécution (sauf si optimisation = 1) est plus long mais pas besoin de cliquer 36 fois sur le bouton pour obtenir une solution à peu près bonne.

Pour voir la différence :

• mettre optimisation à 1 (équivalent à la v1)
• lancer plusieurs fois la macro en cliquant à chaque fois sur le bouton
• les résultats qui se succèdent peuvent osciller entre des nombres différents de ligne égales à cible

Puis :

• mettre optimisation à 30
• lancer une fois la macro en cliquant sur le bouton
• le résultat doit afficher un grand nombre de lignes égales a cible plus souvent (au premier coup)

Notez bien : vu la méthode basée sur la hasard, il se pourra malgré tout que de temps à autre que le résultat avec optimisation = 30 ne soit pas une excellente solution.

 

[labombola46]

Malheureusement, le traducteur google a ajouté "ans" ce qui le rend incompréhensible, je voulais que lorsque je mets un nombre entre 1 et 90 dans la cible, les triplets me donnent la solution comme celle-ci:
Cible sélectionnée 5
Résultat souhaité: 5 45 35 15
Soit 45 + 35 + 15 = 95-90 = 5
ou 5 40 30 25
Soit 40 + 30 + 25 = 95-90 = 5
Bien entendu, les nombres composant les triplets doivent appartenir aux dix proposés en A1: A10.
Si les triplets dont la somme dépasse 180, soustrayez 180