Microsoft 365 combinaisons Macros

[TTI]

Bonjour,
Je souhaite réaliser un macros, qu' a partir d'une liste des données en colonne A Feuille 1 par exemple, de créer une combinaisons des données comme suite :
feuille 1 : Colonne A, j'ai une liste non définie, par exemple :
PP
15
16
17

Je souhaite avoir d'une autre feuille, les résultats

PP
		15​
		16​
		17​
PP15
	15​
		16​
		17​
P16
		15​
	16​
		17​
P17
		15​
		16​
	17​
PP1516
	15​
	16​
		17​
PP1517
	15​
		16​
	17​
PP151617
	15​
	16​
	17​

 

[sylvanu]

Bonjour TTI,
Un essai en PJ.
Votre ex de résultat me semble faux, il manque P1617.
Dans la PJ l'ordre de rangement est le binaire 001,010,011,100 ....
L'ordre n'est pas le même, par contre toutes les combinaisons y sont.
Le résultat est en feuil2.

Sub Dispatche()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
Nbits = DL - 1
IndexW = 1
With Sheets("Feuil2")
    .Cells.ClearContents
    For N = 0 To 2 ^ (DL - 1) - 1 ' DL-1 : Nombre d'éléments. 2 ^ (DL - 1) - 1 : Nombre de combinaisons
        Mot = Right("0000" & Application.Dec2Bin(N), DL - 1) ' met la combinaison en binaire formaté au nombre de bit d'entrée
        Titre = Cells(1, "A")
        Ligne = IndexW
        For B = 1 To Nbits  ' Pour chaque bits
            If Val(Mid(Mot, B, 1)) = 0 Then                 ' si 0 on met à droite
                .Cells(IndexW + B, "C") = Cells(B + 1, "A")
            Else
                .Cells(IndexW + B, "B") = Cells(B + 1, "A") ' si 1 on met à gauche
                Titre = Titre & Cells(B + 1, "A")           ' on ajoute l'élément au titre
            End If
        Next B
        .Cells(Ligne, "A") = Titre                          ' on range le titre
        IndexW = IndexW + Nbits + 1
    Next N
    .Activate
End With
End Sub

 

[TTI]

Merci bcp, ça marche.

 

[TTI]

Bonjour,
J'ai une autre demande, dans le cas ou je souhaite, afficher dans la colonne A par exemple :
PP15PP16 au lieu de PP1516 etc (c'est à dire au lieu de 16 ou 17) est ce posible.
Merci

 

[sylvanu]

Re,
Voilà.

 

[TTI]

Pour info, j'ai pu modifié le code en ajoutons le traitement sur le titre et de modifier la liste
de la Colonne A, :
PP
PP15
PP16
PP17
:

Sub Dispatche()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
Nbits = DL - 1
IndexW = 1
With Sheets("Feuil2")
.Cells.ClearContents
For N = 0 To 2 ^ (DL - 1) - 1 ' DL-1 : Nombre d'éléments. 2 ^ (DL - 1) - 1 : Nombre de combinaisons
Mot = Right("0000" & Application.Dec2Bin(N), DL - 1) ' met la combinaison en binaire formaté au nombre de bit d'entrée
Titre = Cells(1, "A")
Ligne = IndexW
For B = 1 To Nbits ' Pour chaque bits
If Val(Mid(Mot, B, 1)) = 0 Then ' si 0 on met à droite
.Cells(IndexW + B, "C") = Right$(Cells(B + 1, "A"), Len(Cells(B + 1, "A")) - 2)
Else
.Cells(IndexW + B, "B") = Right$(Cells(B + 1, "A"), Len(Cells(B + 1, "A")) - 2) ' si 1 on met à gauche
Titre = Titre & Cells(B + 1, "A") ' on ajoute l'élément au titre
'Right$(MaChaineA, TA - 2)
End If
Next B
If Len(Titre) > 4 Then
.Cells(Ligne, "A") = Right$(Titre, Len(Titre) - 2) ' on range le titre
Else
.Cells(Ligne, "A") = Titre
End If
IndexW = IndexW + Nbits + 1
'Call Convert
Next N
.Activate
End With
End Sub

 

[TTI]

Une remarque SVP, quand je utilise cette liste, j'ai doublons au niveau de la valeur 11 :

PP

3​

5​

7​

9​

11​

13​

 

[sylvanu]

Re,
N'étant pas spécifié, j'avais limité à 5 le nombre de variables. En PJ je l'ai augmenté à 20.

Mot = Right("0000" & Application.Dec2Bin(N), DL - 1)
remplacé par
Mot = Right("00000000000000000000" & Application.Dec2Bin(N), DL - 1)

 

[TTI]

Merci bcp.