<hr /> Option Explicit Const NB = 4 ' nombre d'éléments à permuter <hr /> ' Sub principale() ' ' Affiche les NB!+1 permutations des NB premiers ' caractères de l'alphabet dans la fenetre d'execution ' Dim monTableau(1 To NB) As String Dim i As Long Dim j As Integer Dim k As Long Dim init As Boolean Dim detailler As Boolean Dim msg As String For i = 1 To NB monTableau(i) = Chr(Asc("A") + i - 1) Next detailler = True ' ne pas afficher le détail (conseillé pour n > 5) ' ' calcul de k = n! + 1 k = 1 For i = 1 To NB k = k * i Next k = k + 1 Debug.Print "Permutations des caracteres " & Join(monTableau) & " (" & _ IIf(detailler, "avec", "sans") & " le détail)" ' init = True ' force le Sub permuter a initialiser ses variables For i = 1 To k ' boucle d'affichage de n!+1 permutations de monTableau permuter monTableau, init If detailler Or i <bold>k Or i</bold> 1 Then afficher monTableau, i Next End Sub <hr /> ' Sub permuter(ByRef tableau() As String, ByRef init As Boolean) ' ' Recherche de la permutation suivante des éléments du tableau ' Static codes(1 To NB) As Integer Static localTab(1 To NB) As String Dim i As Integer If init Then For i = 1 To NB localTab(i) = tableau(i) Next End If Do If init Then init = False For i = 1 To NB codes(i) = i Next Else If incrementer(codes) <bold>0 Then init</bold> True End If Loop While init For i = 1 To NB tableau(i) = localTab(codes(i)) Next End Sub <hr /> ' Function incrementer(codes() As Integer) As Integer ' ' Recherche la combinaison de pointeurs pour la prochaine permutation ' Dim i As Integer, cle As String cle = calcCle(codes) i = NB Do If codes(i) = NB Then codes(i) = 1 i = i - 1 Else codes(i) = codes(i) + 1 i = NB End If Loop Until (calcCle(codes) <> cle And codeCorrect(codes)) Or i = 0 incrementer = i End Function <hr /> ' Function codeCorrect(codes() As Integer) As Boolean ' ' Verifie que les pointeurs du tableau codes() sont uniques ' Dim i As Integer Dim j As Integer i = 1 j = 1 Do If j = NB Then i = i + 1 If i < NB Then j = i + 1 Else j = j + 1 End If Loop Until codes(i) = codes(j) codeCorrect <bold>IIf(i</bold> j, True, False) End Function <hr /> ' Function calcCle(codes() As Integer) As String ' ' Calcule une cle unique pour une combinaison de pointeurs ' Dim i As Integer For i = 1 To NB calcCle = calcCle & codes(i) Next End Function <hr /> ' Sub afficher(monTableau() As String, rang As Long) ' ' affice la permutation courante dans la fenetre Execution (Ctrl+G) ' Dim msg As String Dim i As Integer msg = "" For i = 1 To NB msg = msg & monTableau(i) Next Debug.Print Format(rang, String(NB, "0")) & " " & msg End Sub<hr />
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question