Matrice avec toutes les combinaisons de k éléments dans N

Alexander -  
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour,
je cherche à créer une fonction qui, à partir d'un argument N, me renverra une matrice à N colonnes avec toutes les combinaisons possibles de 0 et 1. Par exemple :

Matrice(3) =
001
010
100
110
101
011
111

J'avoue que je galère depuis plusieurs semaines dessus...
Si quelqu'un pouvait me donner la solution ou la philosophie à considérer pour y parvenir, se serait très appréciable.
En vous remerciant par avance.
A voir également:

9 réponses

Réponse 1 / 9
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

Je suppose que ton exemple avec 0 et 1 n'est qu'un exemple.
Tu voudras certainement les combinaisons de, par exemple :
Matrice(6) avec 0123
Soit :
000123
001023
010023
100023
002013
etc...
333333
0
Réponse 2 / 9
Alexander
 
En fait ce que je cherche c'est obtenir une matrice qu'avec des 0 et 1 (que l'on pourrait traduire par false et true). Mais si une fonction permet de faire la même chose avec d'autres chiffres (2, 3 comme dans ton exemple et plus), elle pourrait logiquement en faire de même avec mon cas particulier de 0 et 1.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Je te pose la question car l'algorithme est totalement différent.
Je regarde si je sais faire...ou pas!
0
Alexander
 
Merci beaucoup !
0
Réponse 3 / 9
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour
Un essai avec le nombre en B1 (limité à 9)
https://www.cjoint.com/c/FDvn3NZuEGk
A tester
cdlt
0
Alexander
 
Merci beaucoup. J'en reviens pas du nombre de ligne de code ! Je vais regarder ça et tenter de créer une fonction avec si possible avec un nombre d’élément supérieur à 9. Encore merci à vous !
0
Réponse 4 / 9
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour Frenchie,

Très bon code utilisant des formules.
J'étais parti dans cette direction, mais tu as été plus rapide.
Alors je propose une alternative.
A tester, mais je pense que les seules limites sont :
> la durée ==> très long après N=9
> la restitution dans une feuille si N > 16 est à modifier
> la puissance du pc...

Le code : 

Option Explicit

    Dim Matrice_Finale As Object
    
    Sub test()
    Dim Cle
    
        Call Matrice(4, "0", "1")
        'restitution
        'For Each Cle In Matrice_Finale.Keys
        '    Debug.Print Cle
        'Next
        'limité à N = 16 car 65536 résultats.
        '17 ne passe pas à cause d'Application Transpose
        '[A1].Resize(Matrice_Finale.Count) = Application.Transpose(Matrice_Finale.Keys)
        
        'si séparation des caractères pour affichage sur plusieurs colonnes
        'Dim Eclate, j As Byte, Sortie As String
        'For Each Cle In Matrice_Finale.Keys
        '    Eclate = Split(StrConv(Cle, vbUnicode), Chr(0))
        '    Sortie = ""
        '    For j = 0 To UBound(Eclate) - 1
        '        Sortie = Eclate(j) & "-" & Sortie
        '    Next j
        '    Debug.Print Sortie
        'Next
    End Sub

    Sub Matrice(N As Byte, Digit_1 As String, Digit_2 As String)
    Dim Chaine As String, temp As Variant, i As Long
    
        Chaine = String(N, Digit_1) & String(N, Digit_2)
        Set Matrice_Finale = CreateObject("Scripting.Dictionary")
        For i = 1 To N + 1
            Combiner Mid(Chaine, i, N), ""
        Next i
    End Sub
        
    Sub Combiner(strText As String, debut As String)
    Dim i As Integer
    
        If Len(strText) = 1 Then
            Matrice_Finale(debut & strText) = ""
        Else
            For i = 1 To Len(strText)
                Combiner Mid(strText, 2, Len(strText) - 1), debut & Mid(strText, 1, 1)
                strText = Mid(strText, 2, Len(strText) - 1) & Mid(strText, 1, 1)
            Next
        End If
    End Sub
0
Alexander
 
Je vais regarder ça minutieusement. Encore merci !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 9
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonsoir
Autre méthode qui traite 20 caractères soit 1048576 combinaisons (l'équivalent d'une colonne pleine d'excel 2007) en 8mn sur mon PC, évidemment pour des quantités demandées plus faible, l'exécution est assez rapide.
Je n'ai pas cherché à vous laissé le choix du nombre de caractères (manque de temps), soit vous le faites vous-même en modifiant le code, soit vous patientez un peu.
https://www.cjoint.com/c/FDvvpQ2vnZw
Cdlt
0
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour Alexander, bonjour Pijaku
Je pense qu'avec l'aide de quelques dictionnaires(je ne connais pas la taille max d'un dictionnaire),le temps devrait être considérablement réduit.
Je regarderai ça dans la journée, à moins quelqu'un d'ici là fasse une proposition.
Bonne journée
0
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
A Pijaku
Bonjour Pijaku
j'ai besoin de vos connaissances, revoici le résultat avec utilisation d'un dictionnaire, mais je n'arrive pas à afficher le résultat, qu'est-ce qui cloche? 

Sub Convertir3()
    Application.ScreenUpdating = False
    Dim Cel As Variant
    Columns(1).ClearContents
    Temps = Timer
    Set Dico = CreateObject("Scripting.Dictionary")
    For A = 0 To 1
     For B = 0 To 1
      For C = 0 To 1
       For D = 0 To 1
        For E = 0 To 1
         For F = 0 To 1
          For G = 0 To 1
           For H = 0 To 1
            For I = 0 To 1
             For J = 0 To 1
              For K = 0 To 1
               For L = 0 To 1
                For M = 0 To 1
                 For N = 0 To 1
                  For O = 0 To 1
                   For P = 0 To 1
                    For Q = 0 To 1
                     For R = 0 To 1
                      For S = 0 To 1
                       For T = 0 To 1
                        x = A & B & C & D & E & F & G & H & I & J & K & L & M & N & O & P & Q & R & S & T
                        Dico.Add x, ""
                       Next T
                      Next S
                     Next R
                    Next Q
                   Next P
                  Next O
                 Next N
                Next M
               Next L
              Next K
             Next J
            Next I
           Next H
          Next G
         Next F
        Next E
       Next D
      Next C
     Next B
    Next A
   [A1].Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
   MsgBox Timer - Temps & " secondes"
End Sub


merci
Salutations
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention  
 
Salut Frenchie83,

La fonction Transpose de VBA n'est en fait que la WorksheetFunction Transpose.
Elle est restée au format xl2003 au passage à Xl2007. D'ou un nombre de lignes limité à 65536. Au delà, ça plante.
Il te faut, pour transposer tes infos, passer par une boucle.
0
Réponse 6 / 9
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Pijaku un grand merci
Toujours de bon conseil, mais c'est vraiment dommage de devoir repasser par une boucle, on perd le bénéfice obtenu par l'utilisation du dictionnaire.
Avec mon PC de bureau qui n'est pas des plus rapides, j'arrive tout de même à un temps supérieur à 5mn pour le remplissage de la colonne entière, ce qui est tout de même acceptable.
https://www.cjoint.com/c/FDwgDo2eg3l
Encore merci pour le coup de main
Bonne journée
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
De rien.
Je suis en train de regarder un code pour réduire les lenteurs de ta boucle.
Patiente encore un peu.

Par contre, juste comme ça, sur le forum Programmation en général, il est préférable de mettre les codes directement en réponse, comme tu l'as fait plus haut.
Les fichiers joints ne sont, en effet, pas éternels...
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Et voilà.
Ton code, légèrement modifié, s'exécute en 15 secondes : 

        Sub Convertir3()
        Application.ScreenUpdating = False
        Dim TB(1 To 1048576, 1 To 1) As Variant, Cpt As Long
        Columns(1).ClearContents
        Temps = Timer
        For A = 0 To 1
         For B = 0 To 1
          For C = 0 To 1
           For D = 0 To 1
            For E = 0 To 1
             For F = 0 To 1
              For G = 0 To 1
               For H = 0 To 1
                For i = 0 To 1
                 For j = 0 To 1
                  For K = 0 To 1
                   For L = 0 To 1
                    For M = 0 To 1
                     For N = 0 To 1
                      For O = 0 To 1
                       For P = 0 To 1
                        For Q = 0 To 1
                         For R = 0 To 1
                          For S = 0 To 1
                           For t = 0 To 1
                           Cpt = Cpt + 1
                           TB(Cpt, 1) = A & B & C & D & E & F & G & H & i & j & K & L & M & N & O & P & Q & R & S & t
                           Next t
                          Next S
                         Next R
                        Next Q
                       Next P
                      Next O
                     Next N
                    Next M
                   Next L
                  Next K
                 Next j
                Next i
               Next H
              Next G
             Next F
            Next E
           Next D
          Next C
         Next B
        Next A
       [A1].Resize(UBound(TB, 1), 1) = TB
       Debug.Print Timer - Temps & " secondes"
    End Sub


Ne te reste plus qu'à en faire une fonction qui accepte le nombre de chiffres en paramètre...
0
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338 > pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention  
 
Excellent,
l'idée du dictionnaire à été abandonnée au profit d'un tableau, ce qui permet de ne plus avoir le problème de la transposition.
Sur mon PC du bureau, il met 2mn30s, mais comme je l'ai déjà dit , ce n'est pas une fusée. Je testerai ce soir sur mon PC perso beaucoup plus rapide.
Encore bravo et merci
0
Réponse 7 / 9
Alexander
 
Bonjour et un grand merci à vous 2 ! Vous avez développé en quelques heures ce que je n'ai pas réussis à faire en plusieurs semaines. J'espère que vous êtes des développeurs, cela me fera moins complexer... Je vais regarder vos codes avec attention (et tenter de comprendre ce qu'est un dictionnaire en VBA).
0
Réponse 8 / 9
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour Alexander, Bonjour Pijaku
Voici avec le choix du nombre d'éléments, j'ai fait au plus simple.
https://www.cjoint.com/c/FDxjeLfWtsw

A Pijaku: Je n'arrive pas à obtenir le temps de 15 secondes pour 20 chiffres, pourtant j'ai un microprocesseur 4 coeurs. Je reste dans les temps de 4mn.
j'ai appliqué un format autre que texte à la colonne 1, mais suivant les cas, à partir de la ligne 32679, ça ne colle plus. J'ai donc forcé le format à texte en début de code.
Bonne journée
0
Alexander
 
Bonjour. Encore merci. je vais regarder ça et transformer en fonction. Bonne journée.
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > Alexander
 
Bonjour,

@ Frenchie : il faudrait, en amélioration, prévoir :
> une sortie à chaque boucle For pour éviter d'en faire 20 lorsque 7 suffisent
> L'utilisation de Right te permettrai de zapper le Select Case : 
Tb(Cpt, 1) = Right(A&B&C&...&S&T, Nb)
0
Réponse 9 / 9
Frenchie83 Messages postés 2240 Date d'inscription   Statut Membre Dernière intervention   338
 
Bonjour Alexander, Bonjour Pijaku
A Pijaku:
une sortie à chaque boucle For pour éviter d'en faire 20 lorsque 7 suffisent , c'était prévu avec la ligne suivante 
If [B1] < 20 And TB(Cpt, 1) = Valeur Then GoTo Restitution

Malheureusement pour améliorer la présentation du code, j'ai malencontreusement supprimer la ligne suivante: 
Valeur = Application.WorksheetFunction.Rept(1, [B1])
ce qui évidemment l'obligeait à traiter les 20 cas, vu qu'il ne trouvait jamais la variable "valeur".
Voici la correction avec la suppression des select case, ce qui fait plus pro. 

Sub Convertir()
    Application.ScreenUpdating = False
    Dim TB(1 To 1048576, 1 To 1) As Variant, Cpt As Long
    If [B1] < 2 Or [B1] > 20 Or [B1] = "" Or Not IsNumeric([B1]) Then Exit Sub
    Valeur = Application.WorksheetFunction.Rept(1, [B1])
    Columns("A:A").NumberFormat = "@"
    Columns(1).ClearContents
    Temps = Timer
    For A = 0 To 1
     For B = 0 To 1
      For C = 0 To 1
       For D = 0 To 1
        For E = 0 To 1
         For F = 0 To 1
          For G = 0 To 1
           For H = 0 To 1
            For i = 0 To 1
             For J = 0 To 1
              For K = 0 To 1
               For L = 0 To 1
                For M = 0 To 1
                 For N = 0 To 1
                  For O = 0 To 1
                   For P = 0 To 1
                    For Q = 0 To 1
                     For R = 0 To 1
                      For S = 0 To 1
                       For T = 0 To 1
                        Cpt = Cpt + 1
                        TB(Cpt, 1) = Right(A & B & C & D & E & F & G & H & i & J & K & L & M & N & O & P & Q & R & S & T, [B1])
                        If [B1] < 20 And TB(Cpt, 1) = Valeur Then GoTo Restitution
                       Next T
                      Next S
                     Next R
                    Next Q
                   Next P
                  Next O
                 Next N
                Next M
               Next L
              Next K
             Next J
            Next i
           Next H
          Next G
         Next F
        Next E
       Next D
      Next C
     Next B
    Next A
    
Restitution:
    [A1].Resize(UBound(TB, 1), 1) = TB
    MsgBox Timer - Temps & " secondes"
End Sub

Encore merci Pijaku et bonne journée à tout les deux
Cordialement
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Allez, juste pour chipoter, deux-trois modifs de ton code : 

Sub Convertir()
    Dim TB() As Variant, Cpt As Long, Nb As Byte
    Dim A As Byte, B As Byte, C As Byte, D As Byte, E As Byte, F As Byte
    Dim G As Byte, H As Byte, I As Byte, J As Byte, K As Byte, L As Byte
    Dim M As Byte, N As Byte, O As Byte, P As Byte, Q As Byte, R As Byte
    Dim S As Byte, T As Byte, LB As Long
    
    Application.ScreenUpdating = False
    
    On Error Resume Next
    Nb = [B1]
    On Error GoTo 0
    If Nb < 2 Or Nb > 20 Or Nb = 0 Then Exit Sub
    
    LB = Application.WorksheetFunction.Power(2, Nb)
    ReDim Preserve TB(1 To LB, 1 To 1)
    
    Valeur = Application.WorksheetFunction.Rept(1, Nb)
    Columns("A:A").NumberFormat = "@"
    Columns(1).ClearContents
    Temps = Timer
    
    For A = 0 To 1
     For B = 0 To 1
      For C = 0 To 1
       For D = 0 To 1
        For E = 0 To 1
         For F = 0 To 1
          For G = 0 To 1
           For H = 0 To 1
            For I = 0 To 1
             For J = 0 To 1
              For K = 0 To 1
               For L = 0 To 1
                For M = 0 To 1
                 For N = 0 To 1
                  For O = 0 To 1
                   For P = 0 To 1
                    For Q = 0 To 1
                     For R = 0 To 1
                      For S = 0 To 1
                       For T = 0 To 1
                        Cpt = Cpt + 1
                        TB(Cpt, 1) = Right(A & B & C & D & E & F & G & H & I & J & K & L & M & N & O & P & Q & R & S & T, Nb)
                        If Nb < 20 And TB(Cpt, 1) = Valeur Then GoTo Restitution
                       Next T
                      Next S
                     Next R
                    Next Q
                   Next P
                  Next O
                 Next N
                Next M
               Next L
              Next K
             Next J
            Next I
           Next H
          Next G
         Next F
        Next E
       Next D
      Next C
     Next B
    Next A
    
Restitution:
    [A1].Resize(UBound(TB, 1), 1) = TB
    MsgBox Timer - Temps & " secondes"
End Sub
0

Discussions similaires

Afficher toutes les lignes masquées excel
livlarsen -
Mehdiiii -

27 réponses
remettre toutes les colonnes et les lignes masquées
mousaillon -
oumnas -

4 réponses
Probleme d'affichage de ligne dans Excel
sammy79 -
Pierre65 -

12 réponses