Accélération du code existant.

[JJ1]

Bonjour à tous,

J'utilise un petit code pour développer une série de 9 nombres placés en J1:R1 en 9 séries de 8 nombres de A2 à H10:

Dim N(9) As Integer
Dim P As Integer
Nt = 9
For i = 1 To 9: N(i) = Cells(1, 9 + i): Next
P = 1
For A = 1 To Nt
For B = A + 1 To Nt
For C = B + 1 To Nt
For D = C + 1 To Nt
For E = D + 1 To Nt
For F = E + 1 To Nt
For G = F + 1 To Nt
For H = G + 1 To Nt

P = P + 1
Range("A" & P) = N(A)
Range("B" & P) = N(B)
Range("C" & P) = N(C)
Range("D" & P) = N(D)
Range("E" & P) = N(E)
Range("F" & P) = N(F)
Range("G" & P) = N(G)
Range("H" & P) = N(H)

Next H
Next G
Next F
Next E
Next D
Next C
Next B
Next A

Ce code a tendance à "ramer" , auriez-vous une astuce pour le "booster" ?

Merci de votre aide

a+

 

[homepyrof53]

Re : Accélération du code existant.

Bpnjour,

Sans rentrer dans ton code
Ajoute au début de macro

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

et en fin

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Cordialement

 

[JJ1]

Re : Accélération du code existant.

Bonjour homepyrof53,

C'est déjà intégré dans le programme global, il me semble que l'on peut modifier le code à partir du moment où l'on connait les plages et nombres "fixés" 9 en 8, J1:R1, A2:H10 au lieu des variables?

Tu me diras
merci

 

[MJ13]

Re : Accélération du code existant.

Bonjour JJ1, Homepyrof
J'ai fait le test, et cela m'a mis 0.015 secondes. C'est pas très lent .

 

[JJ1]

Re : Accélération du code existant.

Bonjour MJ13,
merci de ton test.
Intégré dans mon code, c'est lent ! Est-il possible de remplacer dans le code toutes ces variables par des constantes que je donne dans mon sujet (plage entrée/destination, lignes, nombres 9 et 8...?
merci

 

[job75]

Re : Accélération du code existant.

Bonjour JJ1, homepyrof53, Michel,

Ce qui fait toujours gagner beaucoup de temps c'est l'utilisation de tableaux VBA pour les calculs.

A la fin on l'entre d'un coup dans la plage de restitution.

A+

 

[JJ1]

Re : Accélération du code existant.

Bonjour Job,

Merci de ta réponse, et as-tu une idée comment l'appliquer au code joint?
merci car c'est pas simple.

A+

 

[Bernard_XLD]

Re : Accélération du code existant.

Bonjour

voici le même code avec un tableau

Cordialement, @+

Sub essai()
Dim N(9) As Integer
 Dim P As Integer
 Dim Tab_Données as variant
 Nt = 9
 For i = 1 To 9: N(i) = Cells(1, 9 + i): Next
 P = 1
 For A = 1 To Nt
    For B = A + 1 To Nt
       For C = B + 1 To Nt
          For D = C + 1 To Nt
             For E = D + 1 To Nt
                For F = E + 1 To Nt
                   For G = F + 1 To Nt
                      For H = G + 1 To Nt
                         P = P + 1
                         Tab_Données = Array(N(A), N(B), N(C), N(D), N(E), N(F), N(G), N(H))
                         ActiveSheet.Range("A" & P & ":" & "H" & P).Value = Tab_Données
                      Next H
                   Next G
                Next F
             Next E
          Next D
       Next C
    Next B
 Next A

End Sub

 

[JJ1]

Re : Accélération du code existant.

Bonjour Yeahou

Merci pour ton code modifié, je vais l'installer dans mon fichier.

Bonne journée

 

[job75]

Re : Accélération du code existant.

Re,

Merci de ta réponse, et as-tu une idée comment l'appliquer au code joint?

Oui, comme ceci :

Sub Macro()
Dim Nt%, col%, N, P&, A%, B%, C%, D%, E%, F%, G%, H%, t(), tablo(), i&, j%
Nt = 9
col = 8
N = Application.Transpose(Application.Transpose([J1].Resize(, Nt)))
P = 1
For A = 1 To Nt
For B = A + 1 To Nt
For C = B + 1 To Nt
For D = C + 1 To Nt
For E = D + 1 To Nt
For F = E + 1 To Nt
For G = F + 1 To Nt
For H = G + 1 To Nt

P = P + 1
ReDim Preserve t(1 To col, 1 To P)
t(1, P) = N(A)
t(2, P) = N(B)
t(3, P) = N(C)
t(4, P) = N(D)
t(5, P) = N(E)
t(6, P) = N(F)
t(7, P) = N(G)
t(8, P) = N(H)

Next H
Next G
Next F
Next E
Next D
Next C
Next B
Next A

'---transposition et restitution---
ReDim tablo(1 To P, 1 To col)
For i = 1 To P
  For j = 1 To col
    tablo(i, j) = t(j, i)
  Next
Next
[A:A].Resize(, col).ClearContents 'RAZ
[A1].Resize(P, col) = tablo
End Sub

A+

 

[job75]

Re : Accélération du code existant.

Re,

S'il y a des titres en ligne 1 on peut les mémoriser :

Sub Macro()
Dim Nt%, col%, N, titres, P&, A%, B%, C%, D%, E%, F%, G%, H%, t(), tablo(), i&, j%
Nt = 9
col = 8
N = Application.Transpose(Application.Transpose([J1].Resize(, Nt)))
titres = [A1].Resize(, col)
P = 1
For A = 1 To Nt
For B = A + 1 To Nt
For C = B + 1 To Nt
For D = C + 1 To Nt
For E = D + 1 To Nt
For F = E + 1 To Nt
For G = F + 1 To Nt
For H = G + 1 To Nt

P = P + 1
ReDim Preserve t(1 To col, 1 To P)
t(1, P) = N(A)
t(2, P) = N(B)
t(3, P) = N(C)
t(4, P) = N(D)
t(5, P) = N(E)
t(6, P) = N(F)
t(7, P) = N(G)
t(8, P) = N(H)

Next H
Next G
Next F
Next E
Next D
Next C
Next B
Next A

'---transposition et restitution---
ReDim tablo(1 To P, 1 To col)
For i = 1 To P
  For j = 1 To col
    tablo(i, j) = t(j, i)
  Next
Next
[A:A].Resize(, col).ClearContents 'RAZ
[A1].Resize(P, col) = tablo
[A1].Resize(, col) = titres
End Sub

A+

 

[JJ1]

Re : Accélération du code existant.

Re,

merci beaucoup Job pour ton "tablo" , j'ai de quoi m'occuper...

Bonne journée