Permutation et combinaison de caracteres
RAYON D'EMERAUDE
Messages postés
1
Statut
Membre
-
ccm81 Messages postés 11033 Statut Membre -
ccm81 Messages postés 11033 Statut Membre -
Chers participants du "Donner et du Recevoir"
Je vous remercie pour votre promptitude à apporter la solution idoine aux problèmes posés.
C'est dans cet ordre d'idée que je vous demande ce qui suit:
Par quels moyens (processus, formules....) peut on obtenir en Excel de préférence ou au moyen d'autres applications, toutes les combinaisons possibles issues de permutations de lettres ou de chiffres.
Exemple:
J'ai les sept (7) caractères suivants: a; b; 4; p; z; K; m
Je veux obtenir toutes combinaisons possibles en permutant tous ces caractères.
Comment utiliser l'informatique (Excel ou autres) pour obtenir ces combinaison ?
Merci d'avance à tous.
RAYON D'EMERAUDE
Je vous remercie pour votre promptitude à apporter la solution idoine aux problèmes posés.
C'est dans cet ordre d'idée que je vous demande ce qui suit:
Par quels moyens (processus, formules....) peut on obtenir en Excel de préférence ou au moyen d'autres applications, toutes les combinaisons possibles issues de permutations de lettres ou de chiffres.
Exemple:
J'ai les sept (7) caractères suivants: a; b; 4; p; z; K; m
Je veux obtenir toutes combinaisons possibles en permutant tous ces caractères.
Comment utiliser l'informatique (Excel ou autres) pour obtenir ces combinaison ?
Merci d'avance à tous.
RAYON D'EMERAUDE
4 réponses
-
Bonjour,
Ton problème a dû germer dans pas mal de tête pour jouer au scrabble par exemple mais il n'est pas simple à résoudre.
Il existe quelques programmes qui font cela mais souvent ils fonctionnent avec un dictionnaire.
Sur excel, il faut trouver une macro pour le faire mais il faut surtout la coder car celles que tu trouveras ne sont pas nécessairement adaptées à ta demande précise. -
Bonjour,
J'avais déjà bidouiller quelque chose en VBA à ce sujet, je te le fais parvenir volontiers.
recopies le code ci-dessous dans un module,
l'utilisation est très simple, tu écris en cellule A1 les caractères à permuter (sans séparateur ni espace) maximum 12 caractères, minimum 3, puis tu lances la macro "Initialisation", le mieux c'est de créer un bouton et de lui affecter le macro "initialisation", bon c'est une bidouille, mais ça marche bien
Public Origine Public PartieMere Public PartieFille Public Rejeton Public Reste Public PartieTraitee Public NbrCarPartieTraitee Public MotEntier Public NbrCarMotEntier Public Cpt2Car Public Cpt3Car Public Cpt4Car Public Cpt5Car Public Cpt6Car Public Cpt7Car Public Cpt8Car Public Cpt9Car Public Cpt10Car Public Cpt11Car Public Cpt12Car Public DeuxiemeCar Public PremierCar Public PositionCellule Public LigneRecherchée Public colonneRecherchée Public TempsDebut Public TempsFin Public DateDebut Public DateFin Sub Initialisation() Application.ScreenUpdating = False Sheets("Feuil1").Select Range("A1").Select PartieTraitee = Range("A1").Value PartieFille = "" NbrCarMotEntier = Len(PartieTraitee) DateDebut = Date TempsDebut = Time Select Case NbrCarMotEntier Case Is < 3 Exit Sub Case Is <= 12 Traitement Case Is > 12 MsgBox "maxi 12 caractères" End Select End Sub Sub Traitement() Cpt2Car = 0 Cpt3Car = 0 Cpt4Car = 0 Cpt5Car = 0 Cpt6Car = 0 Cpt7Car = 0 Cpt8Car = 0 Cpt9Car = 0 Cpt10Car = 0 Cpt11Car = 0 Cpt12Car = 0 Select Case NbrCarMotEntier Case 2 GoTo Permutation2Caracteres Case 3 GoTo Permutation3Caracteres Case 4 GoTo Permutation4Caracteres Case 5 GoTo Permutation5Caracteres Case 6 GoTo Permutation6Caracteres Case 7 GoTo Permutation7Caracteres Case 8 GoTo Permutation8Caracteres Case 9 GoTo Permutation9Caracteres Case 10 GoTo Permutation10Caracteres Case 11 GoTo Permutation11Caracteres Case 12 GoTo Permutation12Caracteres End Select Permutation12Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 12 If NbrCarMotEntier = 12 And Cpt12Car = 12 Then AffichageFinal Exit Sub End If If Cpt12Car = 12 Then AffichageFinal Exit Sub End If Permutation Origine = PartieTraitee Cpt12Car = Cpt12Car + 1 Permutation11Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 11 If NbrCarMotEntier = 11 And Cpt11Car = 11 Then AffichageFinal Exit Sub End If If Cpt11Car = 11 Then Cpt11Car = 0 GoTo Permutation12Caracteres End If Permutation Origine = PartieTraitee Cpt11Car = Cpt11Car + 1 Permutation10Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 10 Permutation Origine = PartieTraitee Cpt10Car = Cpt10Car + 1 If NbrCarMotEntier = 10 And Cpt10Car = 10 Then AffichageFinal Exit Sub End If If Cpt10Car = 10 Then Cpt10Car = 0 GoTo Permutation11Caracteres End If Permutation9Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 9 If NbrCarMotEntier = 9 And Cpt9Car = 9 Then AffichageFinal Exit Sub End If If Cpt9Car = 9 Then Cpt9Car = 0 GoTo Permutation10Caracteres End If Permutation Origine = PartieTraitee Cpt9Car = Cpt9Car + 1 Permutation8Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 8 If NbrCarMotEntier = 8 And Cpt8Car = 8 Then AffichageFinal Exit Sub End If If Cpt8Car = 8 Then Cpt8Car = 0 GoTo Permutation9Caracteres End If Permutation Origine = PartieTraitee Cpt8Car = Cpt8Car + 1 Permutation7Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 7 If NbrCarMotEntier = 7 And Cpt7Car = 7 Then AffichageFinal Exit Sub End If If Cpt7Car = 7 Then Cpt7Car = 0 GoTo Permutation8Caracteres End If Permutation Origine = PartieTraitee Cpt7Car = Cpt7Car + 1 Permutation6Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 6 If NbrCarMotEntier = 6 And Cpt6Car = 6 Then AffichageFinal Exit Sub End If If Cpt6Car = 6 Then Cpt6Car = 0 GoTo Permutation7Caracteres End If Permutation Origine = PartieTraitee Cpt6Car = Cpt6Car + 1 Permutation5Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 5 If NbrCarMotEntier = 5 And Cpt5Car = 5 Then AffichageFinal Exit Sub End If If Cpt5Car = 5 Then Cpt5Car = 0 GoTo Permutation6Caracteres End If Permutation Origine = PartieTraitee Cpt5Car = Cpt5Car + 1 Permutation4Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 4 If NbrCarMotEntier = 4 And Cpt4Car = 4 Then AffichageFinal Exit Sub End If If Cpt4Car = 4 Then Cpt4Car = 0 GoTo Permutation5Caracteres End If Permutation Origine = PartieTraitee Cpt4Car = Cpt4Car + 1 Permutation3Caracteres: Origine = PartieTraitee NbrCarPartieTraitee = 3 If NbrCarMotEntier = 3 And Cpt3Car = 3 Then AffichageFinal Exit Sub End If If Cpt3Car = 3 Then Cpt3Car = 0 GoTo Permutation4Caracteres End If Permutation Origine = PartieTraitee Cpt3Car = Cpt3Car + 1 Permutation2Caracteres: DeuxiemeCar = Mid(PartieTraitee, 2, 1) PremierCar = Left(PartieTraitee, 1) Reste = Mid(PartieTraitee, 3, NbrCarMotEntier - 1) PartieTraitee = DeuxiemeCar & PremierCar & Reste Affichage Cpt2Car = Cpt2Car + 1 If Cpt2Car = 2 Then Cpt2Car = 0 GoTo Permutation3Caracteres Else GoTo Permutation2Caracteres End If End Sub Sub Permutation() PartieTraitee = Left(Origine, NbrCarPartieTraitee) PartieMere = Mid(PartieTraitee, 2, NbrCarPartieTraitee - 1) Rejeton = Left(PartieTraitee, 1) If NbrCarMotEntier = NbrCarPartieTraitee Then PartieFille = "" Else PartieFille = Right(Origine, NbrCarMotEntier - NbrCarPartieTraitee) End If PartieTraitee = PartieMere & Rejeton & PartieFille End Sub Sub Affichage() ActiveCell.Value = PartieTraitee PositionCellule = ActiveCell.Address(RowAbsolute:=False) LigneRecherchée = ActiveCell.Row If LigneRecherchée = 1048576 Then PositionCellule = ActiveCell.Address(ColumnAbsolute:=False) 'colonneRecherchée = Left(PositionCellule, 2) colonneRecherchée = ActiveCell.Column If colonneRecherchée = 16384 Then Sheets.Add Range("a1").Select Else ActiveCell.Offset(-1048575, 1).Range("A1").Select Application.ScreenUpdating = True Application.ScreenUpdating = False End If Else ActiveCell.Offset(1, 0).Range("A1").Select End If End Sub Sub AffichageFinal() Application.ScreenUpdating = True Trier DateFin = Date TempsFin = Time MsgBox "la recherche a commencé le " & DateDebut & " à " & TempsDebut & " et fini le " & DateFin & " à " & TempsFin End Sub Sub Trier() For i = 1 To 16384 Columns(i).Select If IsEmpty(ActiveCell.Offset(1, 0)) Then Exit Sub Selection.Sort Key1:=ActiveCell.Offset(1, 0), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Next i End Sub -
-
