Combinaisons d'éléments avec maximum

europeest

XLDnaute Nouveau
Bonjour à tous

Nouveau sur le forum, je tente sans succès pour l'instant de resoudre le problème suivant (en pièce jointe)

J'ai une série de catégories (20 catégories) dont les valeurs peuvent être comprises entre 0 et 10. Le total des valeurs pour chaque combinaison potentielle est fixe et doit être égal à 71.

Je cherche à établir la liste de toutes les combinaisons potentielles sous la forme d'un tableau. J'ai essayé via divers IF etc..., RANDBETWEEN et autres, mais sans succès jusqu'à présent.

Avez-vous déjà résolu des questions similaires, quelle est l'approche à aborder?

Merci pour votre attention.
Cordialement
 

Pièces jointes

  • Test Elements Excel.xlsx
    16.3 KB · Affichages: 111

tototiti2008

XLDnaute Barbatruc
Re : Combinaisons d'éléments avec maximum

Bonjour PierreJean, Bonjour à tous, :)

Etant donné la question, l'ordre des chiffres (1-2-3-4-5-6-7) ne change jamais, on se contente de masquer certains d'entre eux pour les combinaisons. un trou c'est un chiffre masqué. Il y a jusqu'à 5 trous. Le tableau trou contient les rangs des chiffres masqués (rang de 1 à 7).
Au début, un trou au rang 7, puis je diminue le rang jusqu'à 1
Puis un deuxième trou au rang 7, et je remet le 1er au rang 6
Je descend toujours le premier trou jusqu'à ce qu'il atteigne la valeur de son indice (1)
Puis si je change le rang d'un autre trou, je redonne aux trous précédents le rang inférieur à celui changé
Trous doit évoluer comme ça :
7-0-0-0-0
6-0-0-0-0
5-0-0-0-0
...
1-0-0-0-0
6-7-0-0-0 'ajout d'un trou, on donne aux précédents la valeur inférieure
5-7-0-0-0
...
1-7-0-0-0
5-6-0-0-0 'changement de valeur d'un trou, on donne aux précédents la valeur inférieure
...
1-2-0-0-0
5-6-7-0-0 'ajout d'un trou, on donne aux précédents la valeur inférieure
...
La condition de sortie est que chaque trou ait la valeur de son indice
si je ne me trompe pas, le code devrait fonctionner pour plus de 7 valeurs (il suffit de redéfinir le nom Valos) :)

Edit : la méthode Poinçonneur des Lilas :D
 
Dernière édition:

KenDev

XLDnaute Impliqué
Re : Combinaisons d'éléments avec maximum

Bonjour à tous, bonjour PierreJean, Tototiti,

Une solution 'universelle' dans le code suivant. La sub écrit dans la feuille active. Faire varier les paramètres dans la Sub Main.

a = Nombre d'éléments total
Debut = Plus petit des rangs choisis (par omission rang 1)
Fin = Dernier des rangs choisis (par omission rang maximum = a)
SortieNumeric = False pour 1 combinaison texte par cellule, True pour 1 nombre par cellule (par omission False)

Exemples:
_ parmis 7 à partir du rang 2 en sortie texte (demande de Mole):
VB:
Call AllCombins(7, 2)
_ parmis 17, du rang 7 à 9 en sortie numérique
VB:
Call AllCombins(17, 7, 9, True)

Cordialement

KD

VB:
Dim Cb()
Sub Main(): Call AllCombins(7, 2, 0, False): End Sub
Private Sub AllCombins(ByVal a%, Optional Debut% = 1, Optional Fin% = 0, Optional SortieNumeric As Boolean = False)
    Dim i%, j&, r&, k%
    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    If Fin = 0 Then Fin = a
    If Debut < 1 Or Fin < Debut Or Fin > a Then Exit Sub
    For i = Debut To Fin
        ReDim Cb(i)
        For j = 1 To i - 1: Cb(j) = j: Next j
        Cb(j) = Cb(j - 1)
        For j = 1 To CombinNb(a, i)
            Call CombinNext(a)
            r = r + 1
            If SortieNumeric Then
                For k = 1 To i: Cells(r, k) = Cb(k): Next k
            Else
                Cells(r, 1) = Join(Cb)
            End If
        Next j
    Next i
    Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub CombinNext(ByVal a%)
    Dim b%, i%
    b = UBound(Cb)
    If b = a Then Cb(b) = Cb(b) + 1: Exit Sub
    If b = 1 Then Cb(1) = Cb(1) + 1 Else Cb(1) = Cb(1) - (Cb(2) = a - b + 2)
    For i = 2 To b - 1
        If Cb(i + 1) = a - b + i + 1 Then Cb(i) = Cb(i + (Cb(i) = a - b + i)) + 1
    Next i
    If b > 1 Then
        If Cb(b) = a Then Cb(b) = Cb(b - 1) + 1 Else Cb(b) = Cb(b) + 1
    End If
End Sub
Private Function CombinNb(ByVal a%, ByVal b%) As Double
    Dim c%
    c = a - b
    If b < c Then c = b
    If c = 0 Then CombinNb = 1 Else CombinNb = MathFactoriel(a, c) / MathFactoriel(c)
End Function
Private Function MathFactoriel(ByVal Nb%, Optional Iter% = 0) As Double
    Dim i&, n&
    If Iter = 0 Then Iter = Nb
    MathFactoriel = 1
    For i = 0 To Iter - 1: MathFactoriel = MathFactoriel * (Nb - i): Next i
End Function
 

Membres actuellement en ligne

Statistiques des forums

Discussions
314 450
Messages
2 109 726
Membres
110 552
dernier inscrit
jasson