Série de combinaison

[ilinio83]

bonsoir tout le monde,
j'ai mis un code à mon PC composé des chiffres 0-1-3 pour 04 caractères si je me rappelle bien ou 05.
je voudrais avoir la liste de toutes les combinaisons possibles de ces trois chiffres pour le nombre de caractère cité en dessous.
vous allez me sauver la vie .
merci d'avance.

 

[pierrejean]

Re : Série de combinaison

Bonjour ilinio

Vois si cela te convient et Bon courage !!!

 

[job75]

Re : Série de combinaison

Bonjour ilinio83, bonjour Pierre, il y a un bout de temps qu'on ne s'est pas croisé

Voyez le fichier joint avec cette macro :

Sub Arrangements(texte, N)
Dim s, P&, Nar&, tablo(), i&, t$, j&
Range("C2:C" & Rows.Count).ClearContents 'RAZ
N = Int(Val(CStr(N)))
If CStr(texte) = "" Or N < 1 Then Exit Sub
s = Split(CStr(texte), "-")
P = UBound(s) + 1
Nar = P ^ N 'nombre d'arrangements
If Nar > Rows.Count - 1 Then MsgBox Nar & _
  " : impossible d'afficher !", , "Nombre d'arrangements": Exit Sub
ReDim tablo(1 To Nar, 1 To 1)
For i = 1 To Nar
  t = ""
  For j = 1 To N
    t = t & "-" & s(Int((i - 1) * P ^ j / Nar) Mod P)
  Next
  tablo(i, 1) = Mid(t, 2)
Next
[C2].Resize(Nar) = tablo
End Sub

Edit : j'ai remplacé "combinaisons" par "arrangements" comme précisé au post #4 qui suit.

A+

 

[job75]

Re : Série de combinaison

Re,

Noter que dans ma solution précédente l'ordre importe pour les items de chaque terme de la série.

Il faudrait donc utiliser le mot "arrangement" plutôt que "combinaison".

On utilise le mot "combinaison" quand l'ordre des items n'importe pas.

Bien sûr il y a beaucoup moins de combinaisons que d'arrangements.

A+

 

[job75]

Re : Série de combinaison

Re,

Cette solution liste les combinaisons (au sens propre du terme).

Je n'ai pas trouvé l'algorithme permettant de les lister, je suis donc obligé de passer par les "arrangements", de trier les items et de supprimer les doublons.

L'exécution du code prend évidemment plus de temps que pour les arrangements :

Sub Combinaisons(texte, N)
Dim s, P&, Nar&, temp(), d As Object, i&, j&
Range("C2:C" & Rows.Count).ClearContents 'RAZ
N = Int(Val(CStr(N)))
If CStr(texte) = "" Or N < 1 Then Exit Sub
s = Split(CStr(texte), "-")
P = UBound(s) + 1
Nar = P ^ N 'nombre d'arrangements
ReDim temp(1 To N)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To Nar
  For j = 1 To N
    temp(j) = s(Int((i - 1) * P ^ j / Nar) Mod P)
  Next
  Call tri(temp, 1, N) 'tri des items
  d(Join(temp, "-")) = "" 'élimine les doublons
Next
If d.Count > Rows.Count - 1 Then MsgBox d.Count & _
  " : impossible d'afficher !", , "Nombre de combinaisons": Exit Sub
s = d.keys
ReDim temp(1 To d.Count, 1 To 1)
For i = 1 To d.Count 'transposition
  temp(i, 1) = s(i - 1)
Next
[C2].Resize(d.Count) = temp
End Sub

Sub tri(a, gauc, droi)          ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub

Fichier joint.

A+

 

[ilinio83]

Re : Série de combinaison

Bonsoir tout le monde,
je vous remercie infiniment pour votre prompte réponse.
merci encore une fois pour votre aide et votre assistance.
@+

 

[job75]

Re : Série de combinaison

Bonjour le fil, le forum,

Edit : j'ai fait des 2 fichiers un seul avec une MFC dans la feuille Arrangements.

A+