Générer toutes les combinaisons possibles d'une suite

Générer toutes les combinaisons possibles d'une suite - VB/VBA/VBS - Programmation

Marsh Posté le 28-04-2008 à 16:07:40    

Bonjour!
 
Je suis bloqué pour la réalisation d'une macro.
 
J'aimerai pouvoir générer toutes les combinaisons possibles d'une suite.
 
Exemple :
Si on a la suite A-B, le résultat est :
A-B / B-A
Si on a la suite A-B-C, le résultat est :
A-B-C / B-C-A / C-B-A / C-A-B / A-C-B / B-A-C
 
Je ne suis pas très calé en maths, mais je crois que le nombre de possibilités est une factorielle : Nbr_arguments!
 
J'ai fait une macro qui fonctionne jusqu'à 4 éléments. Au dela de 4, cela ne fonctionne plus (toutes les possibilités ne sont pas présentées). Je trouve vraiment que cet algorithme est compliqué et je crois que je ne suis pas en mesure de l'inventer. Avez-vous un algorithme qui effectue ce genre d'opérations?  
 
Je vous remercie de vous être penchés quelques secondes sur mon message et je vous remercie d'avance si vous avez des choses à me proposer.
 
Bon courage! ;-)

Reply

Marsh Posté le 28-04-2008 à 16:07:40   

Reply

Marsh Posté le 23-05-2008 à 17:17:02    

Le mieux c'est que tu nous affiche ton code pour que nous puissions le modifier ensemble :)

Reply

Marsh Posté le 26-05-2008 à 07:54:19    

man_coef a écrit :

Bonjour!
 
Je suis bloqué pour la réalisation d'une macro.
 
J'aimerai pouvoir générer toutes les combinaisons possibles d'une suite.
 
Exemple :
Si on a la suite A-B, le résultat est :
A-B / B-A
Si on a la suite A-B-C, le résultat est :
A-B-C / B-C-A / C-B-A / C-A-B / A-C-B / B-A-C
 
Je ne suis pas très calé en maths, mais je crois que le nombre de possibilités est une factorielle : Nbr_arguments!
 
J'ai fait une macro qui fonctionne jusqu'à 4 éléments. Au dela de 4, cela ne fonctionne plus (toutes les possibilités ne sont pas présentées). Je trouve vraiment que cet algorithme est compliqué et je crois que je ne suis pas en mesure de l'inventer. Avez-vous un algorithme qui effectue ce genre d'opérations?  
 
Je vous remercie de vous être penchés quelques secondes sur mon message et je vous remercie d'avance si vous avez des choses à me proposer.
 
Bon courage! ;-)


 
Salut,
 
Il me semble bien que la macro suivante a été postée sur ce forum:
 

Code :
  1. Public Sub CreationChemin()
  2.     Dim intI1 As Integer, intI2 As Integer, intI3 As Integer
  3.     Dim intI4 As Integer, intI5 As Integer, intI6 As Integer, intN As Integer
  4.     Dim strTab As String
  5.     Dim sngChrono As Single
  6.    
  7.     strTab = UCase(InputBox("Saisissez les éléments : ", "Saisie", "ABCDEF" ))
  8.    
  9.     sngChrono = Timer
  10.    
  11.     intI1 = 1
  12.     Do Until Cells(1, intI1).Value = ""
  13.         intI1 = intI1 + 1
  14.     Loop
  15.     Cells(1, intI1).Select
  16.    
  17.     intN = Len(strTab)
  18.     ActiveCell.Value = strTab
  19.     ActiveCell.Offset(1, 0).FormulaR1C1 = "=counta(R4C:R65536C)"
  20.     ActiveCell.Offset(3, 0).Select
  21.    
  22.     For intI1 = 1 To intN
  23.         For intI2 = 1 To intN
  24.             If intI2 <> intI1 Then
  25.                 For intI3 = 1 To intN
  26.                     If intI3 <> intI1 And intI3 <> intI2 Then
  27.                         If Len(strTab) = 3 Then
  28.                             ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1)
  29.                             ActiveCell.Offset(1, 0).Select
  30.                         Else
  31.                             For intI4 = 1 To intN
  32.                                 If intI4 <> intI1 And intI4 <> intI2 And intI4 <> intI3 Then
  33.                                     If Len(strTab) > 4 Then
  34.                                         For intI5 = 1 To intN
  35.                                             If intI5 <> intI1 And intI5 <> intI2 And intI5 <> intI3 And intI5 <> intI4 Then
  36.                                                 If Len(strTab) > 5 Then
  37.                                                     For intI6 = 1 To intN
  38.                                                         If intI6 <> intI1 And intI6 <> intI2 And intI6 <> intI3 And intI6 <> intI4 And intI6 <> intI5 Then
  39.                                                             ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) _
  40.                                                                             & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1) & Mid(strTab, intI6, 1)
  41.                                                             ActiveCell.Offset(1, 0).Select
  42.                                                         End If
  43.                                                     Next
  44.                                                 Else
  45.                                                     ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) _
  46.                                                         & Mid(strTab, intI4, 1) & Mid(strTab, intI5, 1)
  47.                                                     ActiveCell.Offset(1, 0).Select
  48.                                                 End If
  49.                                             End If
  50.                                         Next
  51.                                     Else
  52.                                         ActiveCell.Value = Mid(strTab, intI1, 1) & Mid(strTab, intI2, 1) & Mid(strTab, intI3, 1) & Mid(strTab, intI4, 1)
  53.                                         ActiveCell.Offset(1, 0).Select
  54.                                     End If
  55.                                 End If
  56.                             Next
  57.                         End If
  58.                     End If
  59.                 Next
  60.             End If
  61.         Next
  62.     Next
  63.    
  64.     Cells(3, ActiveCell.Column).Value = (Timer - sngChrono)
  65. End Sub


 
 

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed