Afficheur_combninatoire

[kakachi]

Bonjour a vous Excelnautes,

je viens vers vous afin de solliciter un peu d'aide

j'ai trouvé un programme sur le forum excel qui fonctionne très bien mais je n'arrive pas a le faire afficher les combinaisons a partir de mes numéros !!!!

je vous joins mon fichier pour visualiser mon problème

Je dis merci a tous ceux qui m'aideront a résoudre ce problème

@+ !!!

 

[Victor21]

Re : Afficheur_combninatoire

Bonjour, kakachi.

Où est la référence aux 7 objets ?

ps : il n'y en a que 6 entre B10 at B15

Je ne suis pas capable de modifier ce code, mais les nombres en D10:H30 correspondent aux indices des possibilités.
Donc en N10 :

=INDEX($B$10:$B$16;D10)

à recopier sur 5 colonnes et 21 lignes te fournira le tableau que tu souhaites.

 

[kakachi]

Re : Afficheur_combninatoire

Bonjour Victor21,

Effectivement, j'ai oublié de mettre la référence aux 7 objets

c'est un exemple pour les 7 objets mais l'idéal, ce serait d'avoir les combinaisons pour 9 objets

je joins le nouveau fichier excel

@+ !!!!

 

[Victor21]

Re : Afficheur_combninatoire

Re,

même principe, mais formule à recopier sur 126 lignes

 

[KenDev]

Re : Afficheur_combninatoire

Bonjour Kakachi, Victor21,

A tester. Cordialement

KD

Edit: Correction

 

[kakachi]

Re : Afficheur_combninatoire

Bonsoir KenDev, Victor21,

je vous remercie à tous les deux pour votre aide précieuse !!!

Kendev, ça fonctionne très bien, c'est cool !!!!

@+ !!!, Bonne soirée, Kakachi

 

[JCGL]

Re : Afficheur_combninatoire

Bonjour à tous,

Sans rien enlever, ni ajouter à quiconque, il me semble que le code original est de Ti...

Si cela est avéré, cela prouvera que ses codes sont éternels.

Repose en Paix...

A+ à tous

 

[KenDev]

Re : Afficheur_combninatoire

Bonsoir JCGL,

Je ne connaissais pas Ti, mais j'ai cru comprendre à travers quelques posts l'immense personnalité Excel qu'il était. Cependant dans le classeur joint mis à part la présentation (j'ai a peu près respecté celle du classeur fourni) et ces deux fonctions (la aussi pour preserver le classeur initial)

Function Fact(Nombre) As Double
Dim Boucle As Integer
Fact = 1
For Boucle = 2 To Int(Nombre)
Fact = Fact * Boucle
Next Boucle
End Function
Function Combin(NbElts As Integer, NbEltsChoisis As Integer)
  Combin = Fact(NbElts) / (Fact(NbEltsChoisis) * Fact(NbElts - NbEltsChoisis))
End Function

le reste est un code à moi (qui n'a rien d'extraordinaire) dont je me sers souvent (avec quelques adaptations à chaque fois selon le contexte) pour répondre à des demandes d'affichages de combinaisons. Si je n'ai pas utilisé le code initial c'est qu'après une lecture en diagonale du code je me suis dit que ce serait plus rapide pour moi d'adapter un vieux code que d'analyser l'existant (si j'y arrive) puis d'éventuellement d'y ajouter la fonctionalité supplémentaire demandée.

Sub Comb()
Dim b%, s%, Nc&, i%, Tb(), j%, oS1 As Worksheet
Set oS1 = Worksheets("Cmb")
If WorksheetFunction.IsNumber(oS1.Cells(2, 1)) Then
    b = oS1.Cells(2, 1)
Else
    MsgBox "Nombre d'objets n'est pas un nombre"
    Exit Sub
End If
If WorksheetFunction.IsNumber(oS1.Cells(4, 1)) Then
    s = oS1.Cells(4, 1)
Else
    MsgBox "Nombre d'emplacements n'est pas un nombre"
    Exit Sub
End If
If b < s Then
    MsgBox "Nombre d'objets < Nombre d'emplacements"
    Exit Sub
End If
If oS1.Cells(Rows.Count, 1).End(xlUp).Row - 7 < b Then
    MsgBox "Nombre d'objets > Liste d'Objets"
    Exit Sub
End If
Application.ScreenUpdating = False
oS1.Range(oS1.Cells(2, 2), oS1.Cells(Rows.Count, Columns.Count)).ClearContents
oS1.Range(oS1.Cells(2, 2), oS1.Cells(Rows.Count, Columns.Count)).Interior.Pattern = xlNone
oS1.Range(oS1.Cells(1, 4), oS1.Cells(1, Columns.Count)).ClearContents
oS1.Range(oS1.Cells(1, 4), oS1.Cells(1, Columns.Count)).Interior.Pattern = xlNone
ReDim Tb(1 To b)
For i = 1 To b
    Tb(i) = oS1.Cells(7 + i, 1)
Next i
Nc = Combin(b, s)
For i = 1 To s
    oS1.Cells(2, 2 + i) = i
Next i
If Nc > 1 Then
    For i = 1 To s
        Select Case i
            Case s
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C=" & b & ",RC[-1]+1,R[-1]C+1)"
            Case 1
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (b - s + 2) & _
                    ",R[-1]C+1,R[-1]C)"
            Case Else
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (b - s + 1 + i) _
                    & ",IF(R[-1]C=" & (b - s + i) & ",RC[-1]+1,R[-1]C+1),R[-1]C)"
        End Select
    Next i
    oS1.Range(oS1.Cells(3, 3), oS1.Cells(3, 2 + s)).Copy Destination:=oS1.Range(oS1.Cells(3, 3), oS1.Cells(Nc + 1, 2 + s))
    Application.CutCopyMode = False
    oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).Copy
    oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
For i = 1 To Nc
    For j = 1 To s
        oS1.Cells(i + 1, j + 2) = Tb(oS1.Cells(i + 1, j + 2))
    Next j
Next i
oS1.Cells(1, 3).Copy
oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
For i = 1 To Nc
    oS1.Cells(i + 1, 2) = i
Next i
If b > 1 Then oS1.Cells(1, 3).AutoFill Destination:=oS1.Range(oS1.Cells(1, 3), oS1.Cells(1, 2 + s)), Type:=xlFillDefault
Application.ScreenUpdating = True
End Sub

Je me joint à toi pour adresser mes meilleures pensées en mémoire de Ti. Je suis sur que j'aurai encore l'occasion de croiser ses codes.

Bien cordialement

KD

Edit : une correction : dans

If b > 1 Then oS1.Cells(1, 3).AutoFill Destinatio

remplacer b par s

 

[kakachi]

Re : Afficheur_combninatoire

Bonsoir JCGL , KenDEV

correction faite au niveau du programme KenDev !!!

je ne connaissais pas Ti, que son âme repose en paix

Bonne soirée

@+ !!! kakachi