Récupérer toutes les combinaisons d'un intervalle d'entier défini par VBA

Question

Je cherche à récupérer toutes les combinaisons possibles pour un intervalle du type : &#91;237--&gt;242&#93; dans mon exemple, la combinaison peut aller jusque 5 termes (ex:237/237/237/242/242). Je pars dans l'idée que 3 termes forment la combinaison, les 2 derniers termes prennent la valeur maximale de l'intervalle par défaut. je sais qu'il existe ((242+1)-237)² soit 216 possibilités ou combinaisons. Cependant, je rencontre des difficultés à retranscrire ds un code rapide (avec des variables tableaux sans passer par des retranscription sur Feuille) la récupération de toutes les combinaisons. Existe-t-il svp un seul algo (avec des boucles imbriquées ??) qui permet de récupérer toutes les combinaisons ? En Fichier un exemple. Voici un extrait de code que j'ai débuté mais je sèche : Sub Combi() Dim Pat(), Etal() Imax = 242 Imin = 237 n = 3 ' pour définir les boucles = nombre de PS à modifier NbV = ((Imax + 1) - Imin) ^ n 'nbre total de combinaisons q = ((Imax + 1) - Imin) 'pour définir les boucles = intervalle d'analyse p = (Imax - Imin) 'pour calcul de la différence entre q et p Seq = NbV / q 'donne le nbre de séquences 'MsgBox q & " ||||| " & NbV 'ReDim Pat(1 To NbV, 1 To 6) 'For i = 1 To NbV ' ex:9 ici 'For k = 1 To n ' ex:2 ici 'For j = 1 To q ' ex:3 ici 'Pat(i, 1) = i 'Pat(i, j + 1) = Imin + (j - 1) 'Pat(i, k + 1) = Imin + (j - 1) 'MsgBox i & " |||||| " & j 'Next 'Next 'Next 'Feuil1.Range("A10").Resize(UBound(Pat, 1), UBound(Pat, 2)) = Pat ReDim Etal(1 To q, 1 To 2) For i = 1 To q 'on aborde le prob autrement Etal(i, 1) = i Etal(i, 2) = Imin + (i - 1) ' on récupère une séquence en tableau Next For i = 1 To NbV If i Mod (q) = 0 Then 'donne 3,6,9 pour i 'Feuil1.Range("A" & i - p).Resize(UBound(Etal, 1), UBound(Etal, 2)) = Etal 'on récupère les séquences à la chaine (n le plus élevé= colonne la plus à droite au niveau de l'intervalle d'analyse) End If Next 'pour l'étalement 'q^k k étant une variable de boucle variant de 1 à n le plus élevé ReDim Pat(1 To NbV, 1 To 6) For k = 1 To n For j = 1 To q ^ k 'donne ds notre exemple : 6^1=6 ; 6^2=36 ; 6^3=216 For i = 1 To NbV 'For i = 1 To q '(q ^ k) / q définit le nbre de valeurs identiques pour chaque n combinaisons 'Pat(j, (n + 2) - k) = Imin 'Next Next Next 'Feuil1.Range("E1").Resize(UBound(Pat, 1), UBound(Pat, 2)) = Pat 'pour test End Sub Merci d'avance...

BsAlv · Accepted Answer

Colonne AA, AE et AI, je pensais que le nombre serait 6^2=36, 6^3=216 et 6^4=1.296, mais apparament pour la colonne AI, il n'y a que 88...

BsAlv · Accepted Answer

Oublie ce 88, je regardais à votre colonne initiale .... Des petits modifs pour améliorer. (nombre &gt;1.048.500, etc)...

BsAlv · Answer

Je n'ai pas compris le système des rangs et tout ça. Alors un essai avec au minimum 3 chiffres identiques, on peut changer la partie de la macro à vos propres spécifications Sub Combinations() i1 = 237 'votre premier chiffre i2 = 242 'votre dernier chiffre i3 = 5 'nombre de chiffre i4 = 3 '3 chiffres identique t = Timer ReDim aux(1 To 5) For i = 1 To UBound(aux): aux(i) = i1: Next ReDim out(1 To 100000, 1 To 1) Do For i = 1 To UBound(aux) 'controle pour voir s'il y a au moins 3 chiffres identique nmb = 0 For j = i To UBound(aux) nmb = nmb - (aux(i) = aux(j)) b = (nmb = i4) If b Then Exit For Next If b Then Exit For Next If b Then 'contrôle est positif = aujouter combinaison au résultat ptr = ptr + 1 out(ptr, 1) = Join(aux, "-") End If aux(1) = aux(1) + 1 If aux(1) &gt; i2 Then aux(1) = i1 For i = 2 To UBound(aux) aux(i) = aux(i) + 1 If aux(i) &lt;= i2 Then Exit For Else If i &lt;&gt; UBound(aux) Then aux(i) = i1 End If Next End If Loop While ptr &lt; UBound(out) And aux(UBound(aux)) &lt;= i2 With Range("AA1") .EntireColumn.ClearContents .Resize(Application.Min(ptr, UBound(out))).Value = out .EntireColumn.AutoFit End With MsgBox Format(ptr, "#,###") & " combinaisons en " & Format(Timer - t, "0.00\s") End Sub...