Ttes les combinaisons possibles parmi 8 chiffres

Bonjour,

Je souhaiterais voir toutes les combinaisons possibles de 3 chiffres différents (ou lettres, ou noms, ou autre) parmi 8 possibles répartis dans 2 tableaux différents.

ex: 1-1-2-3 d'un côté et 1-1-4-5 de l'autre donne 1-2-3 , 1-2-4, 1-2-5 , 1-3-5 , 1-4-5 , 2-4-5 , 3-4-5.

(1-2-3 ou 3-2-1=> c'est pareil, même combinaison)

(1-2-2 => ne fonctionne pas : il n'y a pas 3 chiffres différents)

Je joint une pj ci-dessous, avec de la couleur pour aider un peu.

Merci de votre aide

vvdd

Bonjour

La Macro de Ti te donne l'ensemble des résultats.

A toi d'adapter tes tableaux

Cordialement

Merci beaucoup,

je vais voir ça prochainement si j'y arrive à appliquer cela

A bientôt

vvdd

Bonjour,

Ce que propose Ti est exactement ce que je veux. Malheureusement je n'arrive pas à appliquer cela correctement: Je ne suis pas un pro donc le soucis c'est que je ne sais pas comment pour tout un tableau je peux appliquer la formule sous forme matricielle.(déjà matricielle? est-ce que ça veut dire qu'il faut valider par CTRL ALT enter?)

Ce que je sais faire: Appliquer la formule dans une cellule. Etendre la formule à d'autres cellules (dans ce cas la formule évolue => avec le $ elle peut rester la même mais alors j'ai donc le même résultat partout...)

(cf pj)

Comment dois-je m'y prendre ?

Merci encore pour votre aide

vvdd

Bonjour,

Voici un code réalisant l'opération demandé avec le classeur du premier post. Si j'ai bien compris les tableaux peuvent contenir du texte.

Réalisé sous Excel 2007 mais je ne pense pas avoir utilisé de nouvelles fonctionnalités. J'ai réalisé un seul changement dans votre feuille pour son fonctionnement, la suppression de la colonne 4. Les 2 tableaux étant de couleur différentes je suppose que cela ne posera pas de problèmes.

Questions et propositions d'optimisation bienvenues. Cordialement

Option Explicit

    Sub Comb8()

'à lancer avec la cellule active sur la dernière ligne du tableau
Dim vLPos As Long 'ligne de la cellule active lors du lancement de la macro
Dim vVElt() As Variant 'éléments des 2 tableaux sans les doublons
Dim vbNeD As Byte 'nombres d'éléments des 2 tableaux sans les doublons
Dim i As Byte
Dim j As Byte
Dim k As Long
Dim vLDL As Long 'dernière ligne du tableau
Dim oWs1 As Worksheet
Dim oWs2 As Worksheet
Dim vbNC As Byte 'nombres de combinaisons C(vbNeD,3)
Dim vbDep As Byte '1ère colonne ou l'on trouve un élément non vide

    'Paramètres
    Set oWs1 = ActiveSheet
    vLDL = ActiveCell.Row
    If vLDL < 3 Then
        MsgBox "La cellule active doit correspondre à une ligne des tableaux"
        Exit Sub
    End If

    For k = 3 To vLDL

        'Détermination du 1er élément
        For i = 1 To 8
            If Cells(k, i) <> "" Then
                vbNeD = 1
                ReDim vVElt(1 To vbNeD)
                vVElt(vbNeD) = Cells(k, i)
                vbDep = i
                GoTo Line1
            End If
        Next i
        GoTo Line4

        'Détermination des autres éléments
Line1:
        For i = vbDep + 1 To 8
            For j = 1 To vbNeD
                If Cells(k, i) = vVElt(j) Then GoTo Line2
            Next j
            vbNeD = vbNeD + 1
            ReDim Preserve vVElt(1 To vbNeD)
            vVElt(vbNeD) = Cells(k, i)
Line2:
        Next i

        'Contrôle
        If vbNeD < 3 Then GoTo Line4

        'feuille de travail
        Sheets.Add
        Set oWs2 = ActiveSheet

        'calcul nbr de combinaisons
        Cells(1, 1).FormulaR1C1 = "=COMBIN(" & vbNeD & ",3)"
        vbNC = Cells(1, 1).Value

        'écriture 1ere ligne
        For i = 1 To 3
            Cells(1, i) = i
        Next i
        If vbNC = 1 Then GoTo Line3

        'écriture 2ème ligne
        For i = 1 To 3
            If i = 1 Then
                Cells(2, i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (vbNeD - 3 + 2) & _
                    ",R[-1]C+1,R[-1]C)"
            End If
            If i = 2 Then
                Cells(2, i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (vbNeD - 3 + 1 + i) & _
                    ",IF(R[-1]C=" & (vbNeD - 3 + i) & ",RC[-1]+1,R[-1]C+1),R[-1]C)"
            End If
            If i = 3 Then
                Cells(2, i).FormulaR1C1 = "=IF(R[-1]C=" & vbNeD & ",RC[-1]+1,R[-1]C+1)"
            End If
        Next i

        'copie des formules
        Range(Cells(2, 1), Cells(2, 3)).Copy
        ActiveSheet.Paste Destination:=Range(Cells(2, 1), Cells(vbNC, 3))
        Application.CutCopyMode = False
        Range(Cells(1, 1), Cells(vbNC, 3)).Copy
        Range(Cells(1, 1), Cells(vbNC, 3)).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        Application.CutCopyMode = False

        'remplacement des n° par les éléments correspondants
Line3:
        For i = 1 To vbNC
            For j = 1 To 3
                Cells(i, j) = vVElt(Cells(i, j))
            Next j
        Next i

        'transposition sur la feuille d'origine
        For i = 1 To vbNC
            oWs1.Cells(k, 10 + 4 * (i - 1)) = Cells(i, 1)
            oWs1.Cells(k, 11 + 4 * (i - 1)) = Cells(i, 2)
            oWs1.Cells(k, 12 + 4 * (i - 1)) = Cells(i, 3)
        Next i

        'nettoyage
        Application.DisplayAlerts = False
        oWs2.Delete
        Application.DisplayAlerts = True
        Set oWs2 = Nothing

Line4:
    Next k
    Set oWs1 = Nothing
End Sub

Bonjour

A voir