Tableau de permutations de chiffre sans répétition pour 10 éléments
Je voudrais faire un tableau de permutation sur 10 colones pour avoir toutes les permutations comprise entre 1 et 70.
Mais je reste bloquer, je n'arrive pas a générer les valeurs. La boucle s'arrete a Cells(i, 8) = CInt(Mid(Cells(i, 10), 8, 1)).
Pouvez vous m'aiguilliez?
Merci d'avance
Sub permut10()
Dim tablo(10), i%, ii%, j%, k%, x%, Dico, Y As Boolean
k = 10
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.Dictionary")
Randomize
Do While Not Y
For i = 1 To k
tablo(i) = i
Next
For i = k To 1 Step -1
x = Int(((i) * Rnd) + 1)
j = tablo(x)
tablo(x) = tablo(i)
tablo(i) = j
Next
Dico(tablo(1) & tablo(2) & tablo(3) & tablo(4) & tablo(5) & tablo(6) & tablo(7) & tablo(8) & tablo(9) & tablo(10)) = ""
Erase tablo
Y = Dico.Count = 2600
Debug.Print Dico.Count
Loop
[G1].Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
For i = 1 To 2600
Cells(i, 1) = CInt(Mid(Cells(i, 10), 1, 1))
Cells(i, 2) = CInt(Mid(Cells(i, 10), 2, 1))
Cells(i, 3) = CInt(Mid(Cells(i, 10), 3, 1))
Cells(i, 4) = CInt(Mid(Cells(i, 10), 4, 1))
Cells(i, 5) = CInt(Mid(Cells(i, 10), 5, 1))
Cells(i, 6) = CInt(Mid(Cells(i, 10), 6, 1))
Cells(i, 7) = CInt(Mid(Cells(i, 10), 7, 1))
Cells(i, 8) = CInt(Mid(Cells(i, 10), 8, 1))
Cells(i, 9) = CInt(Mid(Cells(i, 10), 9, 1))
Cells(i, 10) = CInt(Mid(Cells(i, 10), 10, 1))
Next
[G1].Sort Key1:=[G1], Order1:=xlAscending, Header:=xlNo
Columns(10).Delete
End Sub
Bonjour,
Curieusement, vous affichez le résultat en colonne G(la 7ème) et vous rechercher à extraire individuellement les 10 chiffres de ce résultat pour les coller dans les colonnes de 1 à 10 donc au passage vous écrasez le résultat , et donc, pour le remplissage de la 8ème colonne, il n'y a plus de résultat à analyser, d'où l'erreur.
Il faut sauvegarder le résultat dans la 11è colonne (K) et faire les extractions sur les valeurs comprises dans cette colonne..
Ensuite, à quoi sert le tri de cette colonne si c'est pour l'effacer par la suite, je suppose que le tri doit s'appliquer sur l'ensemble du tableau des résultats et qu'ensuite vous vouliez supprimer cette colonne.
Votre code modifié:
Sub permut10()
Dim tablo(10), i%, ii%, j%, k%, x%, Dico, Y As Boolean
k = 10
Application.ScreenUpdating = False
Set Dico = CreateObject("scripting.Dictionary")
Randomize
Do While Not Y
For i = 1 To k
tablo(i) = i
Next
For i = k To 1 Step -1
x = Int(((i) * Rnd) + 1)
j = tablo(x)
tablo(x) = tablo(i)
tablo(i) = j
Next
Dico(tablo(1) & tablo(2) & tablo(3) & tablo(4) & tablo(5) & tablo(6) & tablo(7) & tablo(8) & tablo(9) & tablo(10)) = ""
Erase tablo
Y = Dico.Count = 2600
Loop
[k1].Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
For i = 1 To 2600
Cells(i, 1) = CInt(Mid(Cells(i, 11), 1, 1))
Cells(i, 2) = CInt(Mid(Cells(i, 11), 2, 1))
Cells(i, 3) = CInt(Mid(Cells(i, 11), 3, 1))
Cells(i, 4) = CInt(Mid(Cells(i, 11), 4, 1))
Cells(i, 5) = CInt(Mid(Cells(i, 11), 5, 1))
Cells(i, 6) = CInt(Mid(Cells(i, 11), 6, 1))
Cells(i, 7) = CInt(Mid(Cells(i, 11), 7, 1))
Cells(i, 8) = CInt(Mid(Cells(i, 11), 8, 1))
Cells(i, 9) = CInt(Mid(Cells(i, 11), 9, 1))
Cells(i, 10) = CInt(Mid(Cells(i, 11), 10, 1))
Next
Range("A1:K" & Range("A1").CurrentRegion.Rows.Count).Sort Key1:=Range("K1"), Order1:=xlAscending, Header:=xlNo
Columns(11).Delete
End SubCdlt
Bonjour,
Merci,
Le tableau gènère toutes les permutations de 0 à 10.
En excluant le 0, J'ai essayer de modifier le code pour que les permutations s'étendent jusqu'à 70.
Sans grand succès. Un message d'alerte me signale run time error. Est ce que c'est dans les lignes commencant pas Cells, ou je peux corriger cette anomalie ?
Merci d'avance
bonjour,
si mes calculs sont exacts, tu aurais plus de 1.439.561.377.475.020.000 permutations de nombres sans répétitions pour 10 nombres parmi 70. Il te faudra beaucoup de patience !
pour 10 nombres, il y a 3.628.800 permutations possibles (pas 2600 !)
et il y a 396.704.524.216 manières de tirer 10 nombres parmi 70.
Bonjour,
Je te remercie.
Je cherche le nombre de permutations du chiffre 2.
Cordialement
bonjour,
si mes calculs sont exacts, tu aurais 20,565,162,535,357,400 permutations de nombres sans répétitions pour 10 nombres (dont un 2) parmi 70. Il te faudra malgré tout encore beaucoup de patience !
pour 10 nombres, il y a 3.628.800 permutations possibles (pas 2600 !)
et il y a 5,667,207,489 manières de tirer 10 nombres (dont un 2) parmi 70.
Rebonjour,
Désolé j'ai confondu permutation et combinaison.
Ce que je cherche c'est la combinaison du chiffre 2
cordialement
re-bonsoir,
il y a 5,667,207,489 manières de tirer(=combinaisons) 10 nombres (dont un 2) parmi 70.
Si tu veux faire exploser ton excel voici
Dim c(1 To 1000000, 1 To 1), sol, col, lig
Sub aargh()
Dim v(1 To 69)
For i = 1 To 69
If i > 1 Then v(i) = i + 1 Else v(i) = 1
Next i
s = 0
col = 1
lig = 1
combine v, 10
If sol > 0 Then
Cells(lig, col).Resize(sol, 1) = c
End If
End Sub
Sub combine(v, n, Optional ni = 1, Optional nc = 1, Optional s = "2")
olds = s
For i = ni To 69
s = s & " " & v(i)
If nc = n Then
sol = sol + 1
c(sol, 1) = s
If sol = 500000 Then
Cells(lig, col).Resize(500000, 1) = c
If lig > 1 Then col = col + 1: lig = 1 Else lig = lig + 500000
sol = 0
End If
Else
combine v, n, i + 1, nc + 1, s
End If
s = olds
Next i
End SubBonjour,
Je vous remercie. C'est exactement ca.
Je suppose que si je ne veux pas du chiffre 1, je remplace tout les 1 par 2 sauf les lignes ou il y a une addition?
cordialement
bonjour,
une nouvelle version que tu devrais pouvoir adapter à tes besoins.
Dim c(1 To 500000, 1 To 1), sol, col, lig
Sub aargh()
'paramètres
valeurs_possibles = liste("1,3-70") 'liste des valeurs possibles, exemple liste("1,3-70") les valeurs possibles sont 1 et tous les nombres de 3 à 70
valeurs_imposees = "2" ' valeurs imposees , ne peuvent pas se trouver dans la liste des valeurs possibles
combinaison = 9 ' nombre de valeurs possibles à combiner avec les valeurs imposées
s = 0
col = 1
lig = 1
combine valeurs_possibles, valeurs_imposees, combinaison
If sol > 0 Then
Cells(lig, col).Resize(sol, 1) = c
End If
End Sub
Sub combine(v, s, n, Optional ni = 1, Optional nc = 1)
olds = s
For i = ni To UBound(v)
s = s & " " & v(i)
If nc = n Then
sol = sol + 1
c(sol, 1) = s
If sol = 500000 Then
Cells(lig, col).Resize(500000, 1) = c
lig = lig + 500000
If lig >= 1000000 Then col = col + 1: lig = 1
sol = 0
End If
Else
combine v, s, n, i + 1, nc + 1
End If
s = olds
Next i
End Sub
Function liste(x)
'crée une tableau de nombres sur base d'une chaine de caractères
' les nombres (ou les intervalles) à mettre dans le tableau sont séparés par une virgule, les intervalles doivent comprendre le premier nombre et le dernier nombre séparés par le signe -
' exemples
'liste("2,4,6,8-15") met les nombres 2,4,6,8,9,10,11,12,13,14,15 dans un tableau
'liste("5-10") met les nombres 5,6,7,8,9,10 dans un tableau
Dim valeurs()
ReDim valeurs(1 To 100)
lm = Split(x, ",")
For i = LBound(lm) To UBound(lm)
slm = Split(lm(i), "-")
If UBound(slm) = 1 Then
For k = slm(0) To slm(1)
ctr = ctr + 1
valeurs(ctr) = k
Next k
Else
ctr = ctr + 1
valeurs(ctr) = slm(0) + 0
End If
Next i
ReDim Preserve valeurs(1 To ctr)
liste = valeurs
End FunctionMerci beaucoup, c'est parfait.
C'est nickel
Cordialement
Bonjour,
Pouvez vous m'indiquer un logiciel qui peux faire tourner le programme plus facilement ?
Cordialement
bonjour,
Pouvez vous m'indiquer un logiciel qui peux faire tourner le programme plus facilement ?
plutôt que de demander à la macro d'écrire l'info dans une feuille excel on peut lui demander d'écrire l'info dans un fichier txt. la limite sera l'espace disponible sur le disque.
Mais quand bien même cette info serait disponible, je me demande ce que l'on peut faire de près de 6 milliards de suites de 10 nombres. Il n'y a pas assez d'une vie pour les lire.
Bonjour,
C'est une super idée. L' ordinateur malgré que c'est un quadcore a un peu de mal .Pouvez vous m'indiquer comment faire ?
Merci d'avance
Cordialement
bonsoir,
ce n'est pas une bonne idée. Il est normal que cela prenne du temps, il y a des milliards de données à générer. Tu devras trouver un programme capable d'exploiter les fichiers générés (10.000.000 de combinaisons par fichier)
Dim sol, ns
Sub aargh()
valeurs_possibles = liste("3-70") 'liste des valeurs possibles, exemple liste("1,3-70") les valeurs possibles sont 1 et tous les nombres de 3 à 70
valeurs_imposees = "2" ' valeurs imposees , ne peuvent pas se trouver dans la liste des valeurs possibles
s = 0
col = 1
lig = 1
Cells(1,1) = 0
Cells(1, 1).NumberFormat = "0.00%"
combinaison = 9 ' nombre de valeurs possibles à combiner avec les valeurs imposées
Open "combinaison.txt" For Output As 1
combine valeurs_possibles, valeurs_imposees, combinaison
Close 1
End Sub
Sub combine(v, s, n, Optional ni = 1, Optional nc = 1)
olds = s
For i = ni To UBound(v)
s = s & " " & v(i)
If nc = n Then
sol = sol + 1
If sol = 10000000 Then
ns = ns + 1
sol = 0
Cells(1, 1) = ns / 570
Close 1
Open "combinaison " & ns & ".txt" For Output As 1
End If
Print #1, s
Else
combine v, s, n, i + 1, nc + 1
End If
s = olds
Next i
End Sub
Function liste(x)
'crée une tableau de nombres sur base d'une chaine de caractères
' les nombres (ou les intervalles) à mettre dans le tableau sont séparés par une virgule, les intervalles doivent comprendre le premier nombre et le dernier nombre séparés par le signe -
' exemples
'liste("2,4,6,8-15") met les nombres 2,4,6,8,9,10,11,12,13,14,15 dans un tableau
'liste("5-10") met les nombres 5,6,7,8,9,10 dans un tableau
Dim valeurs()
ReDim valeurs(1 To 100)
lm = Split(x, ",")
For i = LBound(lm) To UBound(lm)
slm = Split(lm(i), "-")
If UBound(slm) = 1 Then
For k = slm(0) To slm(1)
ctr = ctr + 1
valeurs(ctr) = k
Next k
Else
ctr = ctr + 1
valeurs(ctr) = slm(0) + 0
End If
Next i
ReDim Preserve valeurs(1 To ctr)
liste = valeurs
End FunctionBonjour,
Merci pour votre réponse.
Cordialement
Bonjour,
Pouvez vous me sugérer un logiciel approprié?
Merci d'avance
Cordialement