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 10559 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 mars 2023 - 9 mai 2013 à 11:34
ccm81 Messages postés 10559 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 24 mars 2023 - 9 mai 2013 à 11:34
A voir également:
- Permutation et combinaison de caracteres
- Deux caractères manquent dans cette url ✓ - Forum Programmation
- Tableau de combinaison loto 5/90 - Forum Excel
- Clavier mac caractères spéciaux - Guide
- Caractères ascii - Guide
- Tableau de combinaison loto ✓ - Forum Excel
4 réponses
gbinforme
Messages postés
14939
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 657
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
2239
Date d'inscription
lundi 6 mai 2013
Statut
Membre
Dernière intervention
28 janvier 2023
335
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
10559
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
24 mars 2023
2 337
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
10559
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
24 mars 2023
2 337
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
14939
Date d'inscription
lundi 18 octobre 2004
Statut
Contributeur
Dernière intervention
24 juin 2020
4 657
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
24512
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 mars 2023
7 168
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
10559
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
24 mars 2023
2 337
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