Matrice avec toutes les combinaisons de k éléments dans N
Fermé
Alexander
-
21 avril 2016 à 13:17
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 25 avril 2016 à 12:29
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 25 avril 2016 à 12:29
A voir également:
- Générer toutes les combinaisons possibles excel
- Liste déroulante excel - Guide
- Formule excel - Guide
- Si et excel - Guide
- Aller à la ligne excel - Guide
- Mise en forme conditionnelle excel - Guide
9 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
21 avril 2016 à 14:42
21 avril 2016 à 14:42
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
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
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.
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
21 avril 2016 à 15:51
21 avril 2016 à 15:51
Je te pose la question car l'algorithme est totalement différent.
Je regarde si je sais faire...ou pas!
Je regarde si je sais faire...ou pas!
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
21 avril 2016 à 15:56
21 avril 2016 à 15:56
Bonjour
Un essai avec le nombre en B1 (limité à 9)
https://www.cjoint.com/c/FDvn3NZuEGk
A tester
cdlt
Un essai avec le nombre en B1 (limité à 9)
https://www.cjoint.com/c/FDvn3NZuEGk
A tester
cdlt
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
21 avril 2016 à 16:43
21 avril 2016 à 16:43
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 :
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
21 avril 2016 à 23:25
21 avril 2016 à 23:25
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
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
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
22 avril 2016 à 04:23
22 avril 2016 à 04:23
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
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
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
Modifié par Frenchie83 le 22/04/2016 à 07:58
Modifié par Frenchie83 le 22/04/2016 à 07:58
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?
merci
Salutations
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
>
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
22 avril 2016 à 07:59
22 avril 2016 à 07:59
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.
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.
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
22 avril 2016 à 08:36
22 avril 2016 à 08:36
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
22 avril 2016 à 09:02
22 avril 2016 à 09:02
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...
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...
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
22 avril 2016 à 09:14
22 avril 2016 à 09:14
Et voilà.
Ton code, légèrement modifié, s'exécute en 15 secondes :
Ne te reste plus qu'à en faire une fonction qui accepte le nombre de chiffres en paramètre...
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...
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
>
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
22 avril 2016 à 09:45
22 avril 2016 à 09:45
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
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
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).
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
23 avril 2016 à 11:34
23 avril 2016 à 11:34
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
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
>
Alexander
25 avril 2016 à 10:49
25 avril 2016 à 10:49
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 :
@ 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)
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
337
25 avril 2016 à 11:55
25 avril 2016 à 11:55
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
Malheureusement pour améliorer la présentation du code, j'ai malencontreusement supprimer la ligne suivante:
Voici la correction avec la suppression des select case, ce qui fait plus pro.
Encore merci Pijaku et bonne journée à tout les deux
Cordialement
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
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
4 janvier 2024
2 744
25 avril 2016 à 12:29
25 avril 2016 à 12:29
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