Permutation et combinaison de caracteres
Fermé
RAYON D'EMERAUDE
Messages postés
1
Date d'inscription
samedi 4 mai 2013
Statut
Membre
Dernière intervention
4 mai 2013
-
Modifié par GrandCaribou le 4/05/2013 à 20:39
ccm81 Messages postés 10900 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 2 novembre 2024 - 9 mai 2013 à 11:34
ccm81 Messages postés 10900 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 2 novembre 2024 - 9 mai 2013 à 11:34
A voir également:
- Permutation et combinaison de caracteres
- Caractères ascii - Guide
- Caractères spéciaux clavier azerty - Guide
- Caractères spéciaux - Guide
- Exemple de mot de passe à 8 caractères - Guide
- Tableau de combinaison loto - Forum Logiciels
4 réponses
gbinforme
Messages postés
14946
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 706
4 mai 2013 à 22:46
4 mai 2013 à 22:46
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.
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.
Frenchie83
Messages postés
2240
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
11 août 2023
338
6 mai 2013 à 17:16
6 mai 2013 à 17:16
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
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
ccm81
Messages postés
10900
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
2 novembre 2024
2 424
6 mai 2013 à 18:13
6 mai 2013 à 18:13
Bonjour à tous
Une autre solution
https://www.cjoint.com/?3Egsl2GmUDL
bonne suite
Une autre solution
https://www.cjoint.com/?3Egsl2GmUDL
bonne suite
ccm81
Messages postés
10900
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
2 novembre 2024
2 424
Modifié par ccm81 le 6/05/2013 à 21:46
Modifié par ccm81 le 6/05/2013 à 21:46
La même en plus rapide
https://www.cjoint.com/?3Egvd7pyuPp
bonne soirée
https://www.cjoint.com/?3Egvd7pyuPp
bonne soirée
gbinforme
Messages postés
14946
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 706
6 mai 2013 à 22:55
6 mai 2013 à 22:55
Bonjour ccm81,
Chapeau ! c'est une superbe réalisation compacte, rapide, efficace : vraiment TOP.
Seul petit bémol, pour le loto il va y avoir trop de solutions à jouer ;-)
Chapeau ! c'est une superbe réalisation compacte, rapide, efficace : vraiment TOP.
Seul petit bémol, pour le loto il va y avoir trop de solutions à jouer ;-)
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
7 239
6 mai 2013 à 23:58
6 mai 2013 à 23:58
Bonjour à tous,
Très intéressant oui, à regarder tranquillement à une heure moins tardive :-)
eric
Très intéressant oui, à regarder tranquillement à une heure moins tardive :-)
eric
ccm81
Messages postés
10900
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
2 novembre 2024
2 424
9 mai 2013 à 11:34
9 mai 2013 à 11:34
Salut gbinforme
Merci pour ton appréciation enthousiaste. Dommage que le demandeur ne se soit pas manifesté
Bonne journée
Merci pour ton appréciation enthousiaste. Dommage que le demandeur ne se soit pas manifesté
Bonne journée