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
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

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
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.
0
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
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


0
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
Bonjour à tous

Une autre solution
https://www.cjoint.com/?3Egsl2GmUDL

bonne suite
0
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
La même en plus rapide
https://www.cjoint.com/?3Egvd7pyuPp

bonne soirée
0
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
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 ;-)
0
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
Bonjour à tous,

Très intéressant oui, à regarder tranquillement à une heure moins tardive :-)
eric
0
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
Salut gbinforme

Merci pour ton appréciation enthousiaste. Dommage que le demandeur ne se soit pas manifesté

Bonne journée
0