Trouver les combinaisons, besoin d'aide !

[Stralcops]

Bonjour,
j'aimerai faire un tableau excel qui me donnerai toutes les combinaisons (ou arrangement il me semble) dans l'ordre sachant qu'il faut que je trouve un code à 8 chiffre avec 6 valeurs différentes. J’espère trouver de l'aide ! merci !

 

[job75]

Re : Trouver les combinaisons, besoin d'aide !

Re,

Pour 8 chiffres le fichier final avec :

Sub Arrangements()
Dim dif, dossier$, nom$, dur#, col%, t()
Dim a, b, c, d, e, f, g, h, n1, n2, n3, n4, n5, n6, n7
Dim x1$, x2$, x3$, x4$, x5$, x6$, x7$, n&, total&
dif = 6 'nombre de chiffres différents
dossier = ThisWorkbook.Path & "\Arrangements\"
If Dir(dossier, vbDirectory) = "" Then MkDir dossier 'création du dossier
nom = Dir(dossier & "Mio*.xls*")
While nom <> ""
  Kill dossier & nom 'vidage du dossier
  nom = Dir
Wend
If dif > 8 Then Exit Sub 'sécurité
dur = Now
col = 1
ReDim t(1 To 50000, 1 To 20) 'base 1
Feuil1.[B1:C1] = ""
Application.DisplayAlerts = False 'si un fichier a déjà été créé
For a = 0 To 9
  For b = 0 To 9
    n1 = 1 - (a <> b)
    x1 = a & b
    If n1 < dif - 6 Then GoTo 1
    For c = 0 To 9
      n2 = n1 - (InStr(x1, c) = 0)
      x2 = x1 & c
      If n2 < dif - 5 Then GoTo 2
      For d = 0 To 9
        n3 = n2 - (InStr(x2, d) = 0)
        x3 = x2 & d
        If n3 < dif - 4 Then GoTo 3
        For e = 0 To 9
          n4 = n3 - (InStr(x3, e) = 0)
          x4 = x3 & e
          If n4 < dif - 3 Then GoTo 4
          For f = 0 To 9
            n5 = n4 - (InStr(x4, f) = 0)
            x5 = x4 & f
            If n5 < dif - 2 Then GoTo 5
            For g = 0 To 9
              n6 = n5 - (InStr(x5, g) = 0)
              x6 = x5 & g
              If n6 < dif - 1 Then GoTo 6
              For h = 0 To 9
                n7 = n6 - (InStr(x6, h) = 0)
                x7 = x6 & h
                If n7 < dif Then GoTo 7
                n = n + 1
                t(n, col) = x7
                If n = 50000 Then
                  total = total + n
                  n = 0: col = col + 1
                  If total Mod 1000000 = 0 Then
                    col = 1
                    Application.ScreenUpdating = False
                    Workbooks.Add xlWBATWorksheet
                    [A1:T50000].NumberFormat = "@"
                    [A1:T50000].HorizontalAlignment = xlCenter
                    [A1:T50000] = t
                    ReDim t(1 To 50000, 1 To 20) 'RAZ
                    nom = "Mio " & Format(total / 1000000, "00") & " - "
                    Feuil1.[B1] = nom & [A1]
                    ActiveSheet.Name = nom & [A1]
                    ActiveWorkbook.SaveAs dossier & nom & [A1]
                    ActiveWorkbook.Close
                    Feuil1.[C1] = Now - dur
                    Application.ScreenUpdating = True
                    DoEvents
                  End If
                End If
7             Next h
6           Next g
5         Next f
4       Next e
3     Next d
2   Next c
1 Next b
Next a
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
[A1:T50000].NumberFormat = "@"
[A1:T50000].HorizontalAlignment = xlCenter
[A1:T50000] = t
ActiveSheet.Name = nom & [A1]
ActiveWorkbook.SaveAs dossier & nom & [A1]
ActiveWorkbook.Close
Feuil1.[B1] = total + n: Feuil1.[C1] = Now - dur
Application.ScreenUpdating = True
DoEvents
MsgBox total + n & " arrangements" & vbLf & _
  "Durée " & Format(Now - dur, "hh:mm:ss")
End Sub

Avec 6 chiffres différents 58 968 000 arrangements, durée 18 minutes 46 secondes.

Avec 7 chiffres différents 18 748 800 arrangements, durée 5 minutes 55 secondes.

Avec 8 chiffres différents 1 814 400 arrangements, durée 34 secondes.

A+

 

[ROGER2327]

Re : Trouver les combinaisons, besoin d'aide !

Bonjour à tous.

Pour les 8-uplets contenant au moins 6 chiffres distincts pris dans l'ensemble des chiffres 0, 1, ..., 9 :​

Sub x10_08d6()
Dim i&, j&, k&, l&, m&, n&, o&, p&, x&, y&, b(9) As Boolean, v$(613199, 0), chemin$
  With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
  chemin = ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & "_x10_08d6" & "\"
  If Dir(chemin, vbDirectory) = "" Then MkDir chemin
  For i = 0 To 9
    With Application: .DisplayAlerts = False: Workbooks.Add xlWBATWorksheet: ActiveWorkbook.SaveAs chemin & i: .DisplayAlerts = False: End With
    x = 0: y = 0
    For j = 0 To 9
      For k = 0 To 9: For l = 0 To 9: For m = 0 To 9: For n = 0 To 9: For o = 0 To 9: For p = 0 To 9
        b(i) = True: b(j) = True: b(k) = True: b(l) = True: b(m) = True: b(n) = True: b(o) = True: b(p) = True
        If b(0) + b(1) + b(2) + b(3) + b(4) + b(5) + b(6) + b(7) + b(8) + b(9) < -5 Then v(x, 0) = i & j & k & l & m & n & o & p: x = x + 1
        Erase b
      Next p, o, n, m, l, k
      ActiveSheet.[A1].Offset(, y).Resize(x, 1).Value = v: Erase v: x = 0: y = y + 1: DoEvents
    Next j
    ActiveWorkbook.Close True
  Next i
  With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
End Sub

Le résultat est enregistré dans un sous-dossier du dossier contenant le classeur où est installée la procédure x10_08d6. Ce sous-dossier a pour nom le nom du classeur suffixé par le nom de la procédure :

nom_du_classeur_x10_08d6​

Il reçoit dix classeurs (à une feuille chacun) 0.xlsx, 1.xlsx, ..., 9.xlsx. Tous les éléments du classeur n.xlsx commencent par le chiffre n.
Dans le classeur n.xlsx, la colonne A contient les éléments commençant par n0, la colonne B ceux commençant par n1, etc. jusqu'à la colonne J qui contient les éléments commençant par n9.

Durée d'exécution chez moi : moins de 10 minutes.
(À titre de comparaison, le code du message #9 s'exécute, chez moi, en 44 minutes 35 secondes.)

Cela dit, mis à part le plaisir de faire chauffer les machines, j'ai toujours autant de mal à comprendre l'intérêt de ce genre de bricolage...​

Bonne journée.


ℝOGER2327
#8248

Mardi 17 Clinamen 143 (Saint Hiéronymus Bosch, démonarque - fête Suprême Quarte)
19 Germinal An CCXXIV, 0,1858h - radis
2016-W14-5T00:26:46Z

 

[Modeste geedee]

Re : Trouver les combinaisons, besoin d'aide !

Bonsour®

Cela dit, mis à part le plaisir de faire chauffer les machines, j'ai toujours autant de mal à comprendre l'intérêt de ce genre de bricolage...

d'autant que le demandeur n'a daigné répondre ne serait-ce qu'a une seule des propositions...
ni expliqué la finalité de la chose !!!

 

[job75]

Re : Trouver les combinaisons, besoin d'aide !

Bonjour à tous,

Je répétais des concaténations inutilement, j'ai revu les macros des posts #15 et #16.

Les durées d'exécution sont pratiquement réduites de moitié.

A+

 

[Lone-wolf]

Re : Trouver les combinaisons, besoin d'aide !

Bonjour job, Roger, Modeste

@Roger: tant qu'on nous chauffe pas les oreilles, cela reste dans les limites du supportable.

@Roger et job: c'est juste une question(peut-être bête)

Vu qu'il y a toutes ces boucles, en mettant une temporisation pour chaque création, cela vas éviter la surchauffe?

 

[ROGER2327]

Re : Trouver les combinaisons, besoin d'aide !

Suite de #17...

Version permettant de choisir le nombre minimum de chiffres distincts dans les arrangements de huit chiffres.

nombre minimum de chiffres distincts	nombre d'arrangements	taille du dossier de sortie	temps d'exécution
===============	===============	===============	===============
8	1 814 400	15,4 Mo	45 s
7	18 748 800	157 Mo	3 min 45 s
6	58 968 000	492 Mo	10 min
5	90 720 000	750 Mo	15 min

Bonne nuit.


ℝOGER2327
#8249

Mercredi 18 Clinamen 143 (Les 27 Êtres Issus des Livres Pairs - Vacuation)
20 Germinal An CCXXIV, 0,8597h - ruche
2016-W14-6T02:03:47Z

 

[job75]

Re : Trouver les combinaisons, besoin d'aide !

Bonjour Roger, le forum,

Votre ordinateur Roger est plus rapide que le mien.

Pour 6 chiffres distincts votre macro s'exécute chez moi en 18 minutes 53 secondes.

Edit : 2ème essai en 18 minutes 23 secondes.

C'est donc la même durée que celle de mon post #16 (18 minutes 46 secondes).

Bonne journée.

 

[ROGER2327]

Re : Trouver les combinaisons, besoin d'aide !

Re...

(...)
Votre ordinateur Roger est plus rapide que le mien.
(...)

Je m'en suis rendu compte en essayant votre procédure du message #9 (~ trois quarts d'heure chez moi).
Quant à votre dernière version elle est généralement plus rapide que la mienne d'une poignée de secondes. Je le dis ainsi parce que, en répétant les essais, les durées d'exécution varient. Mais, le plus souvent, votre procédure optimisée l'emporte.

À propos d'optimisation, je n'aurais jamais pensé écrire

    For b = 0 To 9
      n1 = 1 - (a <> b)
      x1 = a & b
      If n1 < dif - 6 Then GoTo 1
          'code
1:  Next b

au lieu du classique

    For b = 0 To 9
      n1 = 1 - (a <> b)
      x1 = a & b
      If n1 >= dif - 6
          'code
    Next b

Je n'ai pas eu le temps de le vérifier, mais je vous fais confiance : je suppose que ça va plus vite. L'optimisation, c'est vraiment subtil. Il fallait y penser !

Quant à moi, compte tenu que je ne vois pas l'intérêt de ce travail, je ne chercherai pas à optimiser mon code, d'autant plus que le demandeur semble se ficher complètement des réponses que nous apportons.​

Bonne soirée.


ℝOGER2327
#8250

Jeudi 19 Clinamen 143 (Saint Barbeau, procureur et Sainte Morue, juste - fête Suprême Quarte)
21 Germinal An CCXXIV, 7,5625h - gainier
2016-W14-7T18:09:00Z

 

[Modeste geedee]

Re : Trouver les combinaisons, besoin d'aide !

Bonsour®

Quant à moi, compte tenu que je ne vois pas l'intérêt de ce travail, je ne chercherai pas à optimiser mon code, d'autant plus que le demandeur semble se ficher complètement des réponses que nous apportons

peut-être le syndrome du voyageur ???,
le primo-demandeur suite aux 1éres réponses en terme de bienvenue, déstabilisé, aura eu peur et fait demi-tour...
#2

il faut vous armer de patience, il y a beaucoup d'arrangements !!!

#3

j'ai eu le message "Mémoire insuffisante etc".
Il faudrait un ordi plus puissant.
Au total on voit qu'il y a environ 60 millions d'arrangements.

#4

Si l'on arrivait à lister les 60 Mio d'arrangements le fichier pèserait environ 500 Mio d'octets

et je ne parle pas des codes, ni de la qualité du Mega Barbatruc...