code à la synthèse d'une série

Version imprimable

26/11/2015, 21h44
alidroos

code à la synthèse d'une série

Bonjour à tous

Est-il possible de mettre en œuvre la procédure suivante dans le code

AAAA AABA AACA AADA
AAAB AABB AACB AADB
AAAC AABC AACC AADC
AAAD AABD AACD AADD
AAAE AABE AACE AADE
AAAF AABF AACF AADF
AAAG AABG AACG AADG
AAAH AABH AACH AADH
AAAI AABI AACI AADI
AAAJ AABJ AACJ AADJ
AAAK AABK AACK AADK
AAAL AABL AACL AADL
AAAM AABM AACM AADM
AAAN AABN AACN AADN
AAAO AABO AACO AADO
AAAP AABP AACP AADP
AAAQ AABQ AACQ AADQ
AAAR AABR AACR AADR
AAAS AABS AACS AADS
AAAT AABT AACT AADT
AAAU AABU AACU AADU
AAAV AABV AACV AADV
AAAW AABW AACW AADW
AAAX AABX AACX AADX
AAAY AABY AACY AADY
AAAZ AABZ AACZ AADZ

Jusqu'à la dernière série "ZZZZ"
26/11/2015, 21h49
clementmarcotte

Cela doit dépendre de la boule de cristal
26/11/2015, 21h54
alidroos

Bonjour professeur clementmarcotte

Comment façon de faire de ce code ؟

Bonjour

Est-il possible d'améliorer le code suivant déception lente

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sub Qdb()
Application.ScreenUpdating = False
Set Ws = Sheets(1): Set Ws1 = Sheets(2)
On Error GoTo 1
''Sheets(1) A1 To A26 "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z"
         For a = 1 To 26
            f1 = Ws.Range("a" & a)
             n1 = 0
                For b = 1 To 26
                       f2 = Ws.Range("a" & b)
                    For c = 1 To 26
                           f3 = Ws.Range("a" & c)
                         For d = 1 To 26
                                f4 = Ws.Range("a" & d)
                                 n1 = n1 + 1
                                 ww = f1 & f2 & f3 & f4
                                 Ws1.Cells(n1, a) = ww
                         Next d
                    Next c
                Next b
         Next a
Ws1.Activate
1:
Application.ScreenUpdating = True
End Sub

Bonjour,

Je ne suis pas sûr d'avoir bien compris !
Un truc dans le genre peut être ?

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Sub Qdb()
 
    Dim Tbl(1 To 26) As String
    Dim TblCode(1 To 26, 1 To 26) As String
    Dim I As Integer
    Dim J As Integer
    Dim K As Integer
    Dim L As Integer
 
    For I = 1 To 26: Tbl(I) = Chr(64 + I): Next I
 
    For I = 1 To 26
        For J = 0 To 25
            For K = 0 To 25
                For L = 0 To 25
                    On Error Resume Next 'I + J + K en fin de boucle valeur 27
                    TblCode(I + J + K, L + 1) = Tbl(I) & Tbl(J + 1) & Tbl(K + 1) & Tbl(L + 1)
    Next L, K, J, I
 
    Worksheets("Feuil2").Range("A1:Z26") = Application.WorksheetFunction.Transpose(TblCode)
 
End Sub