Permutation et combinaison de caracteres

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

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

        bonne soirée
        1. Contributeur
          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 ;-)
        2. Contributeur
          Bonjour à tous,

          Très intéressant oui, à regarder tranquillement à une heure moins tardive :-)
          eric
        3. Salut gbinforme

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

          Bonne journée