sans connaissance de la fréquence de répartition de ces trois lettres il y aura de nombreux doublonsSalut
je suis nouveau dans votre forum magnifique , j'ai tout vos programmes et j'étais ému par vos performances .
je suis un étudiant , je veux un programme XL qui permet de faire tout les possibilités possibles avec les lettres a,b,c
on a des chaines de caractères de 13 lettres composé par ces 3 lettres seulement par exemple :
aaaaaaaaaaaaa
aaabbbcccabcbainsi de suite .
NB : on aura 2197 chaines de caractères
Salut
je suis nouveau dans votre forum magnifique , j'ai tout vos programmes et j'étais ému par vos performances .
je suis un étudiant , je veux un programme XL qui permet de faire tout les possibilités possibles avec les lettres a,b,c
on a des chaines de caractères de 13 lettres composé par ces 3 lettres seulement par exemple :
aaaaaaaaaaaaa
aaabbbcccabcbainsi de suite .
NB : on aura 2197 chaines de caractères
je voulais un programme qui m'affiche tout les solutions possibles d'une chaîne de 13 caractères composée par les lettres a , b et c
Sub torjan()
Dim Idx As Long, ligne As Integer, colonne As Integer, x As Long
'x = 3 ^ 13
colonne = 1
ligne = 1
Idx = 1
ThisWorkbook.Sheets.Add
Application.ScreenUpdating = False
While Idx < 1594323
If (ligne > 30000) Then
'Application.ScreenUpdating = True
Beep
colonne = colonne + 1
ligne = 1
'Application.ScreenUpdating = False
End If
x = Idx
Cells(ligne, colonne) = Dec2ABC(x)
ligne = ligne + 1
Idx = Idx + 1
'Application.StatusBar = Idx
Wend 'x
Application.ScreenUpdating = True
End Sub
Function Dec2ABC(Nbr As Long) As String
Static Digits As Variant
Dim i As Long, alHolder() As Long, sTemp As String
Digits = VBA.Array("A", "B", "C") '_
i = 0
Do
ReDim Preserve alHolder(0 To i)
alHolder(i) = Nbr Mod 3
i = i + 1
Nbr = Nbr \ 3
Loop While Nbr > 0
sTemp = ""
For i = i - 1 To 0 Step -1
sTemp = sTemp & Digits(alHolder(i))
Next i
Dec2ABC = Right(String(12, "A") & sTemp, 13)
End Function
Sub tyty()
Const b& = 4 '...pour renvoyer le résultat sur 3^b colonnes et 3^(13-b) lignes.
'Excel2003 : b = 3 à 5 ; Excel 2007-2013 : b = 1 à 8.
ThisWorkbook.Sheets.Add
[A1].Resize(3 ^ (13 - b), 3 ^ b).Value = Fonction1(b)
End Sub
Function Fonction1(b&) '...pour renvoyer un tableau de 3^b colonnes et 3^(13-b) lignes.
Dim i&, j&, k&, g&, h&, l&, x$, c$(2), v$()
c(0) = "a": c(1) = "b": c(2) = "c"
g = 13 - b: h = 3 ^ g - 1: l = 3 ^ b - 1
ReDim v(h, l)
For i = 0 To l
x = "": k = i
For j = 1 To b: x = c(k Mod 3) & x: k = k \ 3: Next
For j = 0 To h: v(j, i) = x: Next
Next
For i = 0 To h
x = "": k = i
For j = 1 To g: x = c(k Mod 3) & x: k = k \ 3: Next
For j = 0 To l: v(i, j) = v(i, j) & x: Next
Next
Fonction1 = v
End Function
Application.ScreenUpdating = False
ligne = 1
col = 1
t = Split("a b c")
For n1 = 0 To 2
For n2 = 0 To 2
For n3 = 0 To 2
For n4 = 0 To 2
For n5 = 0 To 2
For n6 = 0 To 2
For n7 = 0 To 2
For n8 = 0 To 2
For n9 = 0 To 2
For n10 = 0 To 2
For n11 = 0 To 2
For n12 = 0 To 2
For n13 = 0 To 2
x = t(n1) & t(n2) & t(n3) & t(n4) & t(n5) & t(n6) & t(n7) & t(n8) & t(n9) & t(n10) & t(n11) & t(n12) & t(n13)
Cells(ligne, col) = x
ligne = ligne + 1
If ligne > 30000 Then
col = col + 1
ligne = 1
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Application.ScreenUpdating
Il manque "AAAAAAAAAAAAA".
Idx = 1
mais Roger tu avouera quand même que 15 sec pour 2197 combinaisons c'est long ...on a des chaines de caractères de 13 lettres composé par ces 3 lettres seulement par exemple :
aaaaaaaaaaaaa
aaabbbcccabcbainsi de suite .
NB : on aura 2197 chaines de caractères
(...)
Roger qui a une machine plutôt rapide:
Chez moi
11 secondes pour tyty
70 secondes pour test
208 pour torjan
Sub tyty3A()
Const Lig& = 30000 '...pour renvoyer le résultat sur Lig lignes.
Dim i&, j&, k&, l&, m&, n&, x$, c$(2), w$()
c(0) = "a": c(1) = "b": c(2) = "c"
n = 3 ^ 13
ReDim w(Lig, n \ Lig)
For m = 0 To n \ Lig
For l = 0 To Lig - 1
If i = n Then Exit For
x = "": k = i
For j = 1 To 13: x = c(k Mod 3) & x: k = k \ 3: Next
w(l, m) = x
i = i + 1
Next l, m
ThisWorkbook.Sheets.Add
[A1].Resize(Lig, m).Value = w
End Sub
(...)
mais Roger tu avouera quand même que 15 sec pour 2197 combinaisons c'est long ...
Re
Je présume que la différence de proportion entre test et torjan est due au fait que je ne m’étais pas permis de toucher au code de Modeste
(...)
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With
Application.ScreenUpdating = False
Application.ScreenUpdating = True
(...)
Par ailleurs , je ferai un essai en passant par un tableau écrit en finale de sub
(...)
(...)
Mais pour l'instant une p... de bronchite me parasite un tantinet
A + donc
J'avoue tout ce qu'on veut, mais je ne vois pas le rapport avec ma proposition...
With Application: .ScreenUpdating = 0: .EnableEvents = 0: .Calculation = -4135: End With
'...
With Application: .Calculation = -4105: .EnableEvents = 1: .ScreenUpdating = 1: End With