Boucle et/ou compteur : optimisation lignes de code

[SkinDash]

Bonjour,

Je cherche à réduire le nombre de lignes d'un code en incorporant une boucle par exemple, cependant je bloque, je ne sais pas trop quel type utiliser et comment.

Je mets en pièce jointe un fichier exemple ou j'ai incorporé le code à optimiser sur la feuille 1.

----

Quelques explications:

Les seules parties de mon code qui bouge sont celles en rouge.
J'ai une suite de I3 à I65 (Cf: fichier exemple)
Et ensuite une suite qui s'articule de la sorte:
D9-D13-D17-D21-D25-D29-D33-D37-D41
E-------
F-------
G-------
H-------
I-------
J-------
Avec le même 'step' pour chaque lettre.

Workbooks(ExtractTCD).Activate
Sheets("TCD1 - Valeurs").Select
Range("I3").Select
Selection.Copy
Workbooks("Matrice Transposition - Template.xlsx").Activate
Sheets("Reclassement matrice").Select
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


Si quelqu'un a une piste pour améliorer je suis preneur.

Merci à vous et très bonne journée.

 

[Dranreb]

Re : Boucle et/ou compteur : optimisation lignes de code

Bonjour.
Essayez comme ça :

Sub Macro1()
Dim Te(), Ts(1 To 1, 1 To 7), L&, C&, PlgCibl As Range
Te = Workbooks("ExtractTCD.xlsx").Worksheets("TCD1 - Valeurs").[I3:I65].Value
Set PlgCibl = Workbooks("Matrice Transposition - Template.xlsx").Worksheets("Reclassement matrice").[D:J]
For L = 1 To 9
   For C = 1 To 7: Ts(1, C) = Te(7 * (L - 1) + C, 1): Next C
   PlgCibl.Rows(Choose(L, 9, 13, 17, 21, 25, 29, 33, 37, 41)).Value = Ts
   Next L
End Sub

Mais j'ai pu me tromper: difficile sans voir la disposition souhaitée ni pouvoir tester.

 

[SkinDash]

Re : Boucle et/ou compteur : optimisation lignes de code

Bonjour Dranreb,

Merci pour cette réponse éclaire

Vraiment impressionnant, tout fonctionne bien (le remplissage) à un 'petit' détail près, le remplissage ne se fait pas dans le bon sens.

Ton code complète les cellules dans cet ordre: (en ligne)

D9-E9-F9-G9-H9-I9-J9-D13-E13-F13-G13-H13-I13-J13-... ect jusqu'à D41-...-J41

Alors qu'il faudrait compléter dans ce sens: (en colonne)

D7-D13-D17-D21-D25-D29-D33-D37-D41-E9-...-E41

Je ne sais pas si je suis très clair ?

Je ne peux malheureusement pas mettre mon fichier source, car il fait plus de 75MO..

Merci pour ton aide précieuse.

 

[Dranreb]

Re : Boucle et/ou compteur : optimisation lignes de code

Mais vous pourriez quand même mettre, dans les cellules d'un tableau symbolisant le résultat souhaité, les numéros de lignes désirés de la plage source (1 pour I3 jusqu'à 63 pour I65)

 

[SkinDash]

Re : Boucle et/ou compteur : optimisation lignes de code

Effectivement, j'ai update le fichier test dans ce message.
Avec sur la feuille 1 la source, et sur la feuille 2 le résultat attendu. (En sachant que dans mes fichiers il ne s'agit pas des feuilles 1 et 2, mais de deux classeurs différents)

merci à vous.

 

[Dranreb]

Re : Boucle et/ou compteur : optimisation lignes de code

Ben voilà, comme ça on y voit tout de suite plus clair.

Sub Macro1()
Dim Te(), Ts(1 To 1, 1 To 7), L&, C&, PlgCibl As Range
Te = Workbooks("ExtractTCD.xlsx").Worksheets("TCD1 - Valeurs").[I3:I65].Value
Set PlgCibl = Workbooks("Matrice Transposition - Template.xlsx").Worksheets("Reclassement matrice").[D:J]
For L = 1 To 9
   For C = 1 To 7: Ts(1, C) = Te(L + 9 * (C - 1), 1): Next C
   PlgCibl.Rows(4 * (L - 1) + 9).Value = Ts
   Next L
End Sub

 

[SkinDash]

Re : Boucle et/ou compteur : optimisation lignes de code

Ben voilà, comme ça on y voit tout de suite plus clair.

Sub Macro1()
Dim Te(), Ts(1 To 1, 1 To 7), L&, C&, PlgCibl As Range
Te = Workbooks("ExtractTCD.xlsx").Worksheets("TCD1 - Valeurs").[I3:I65].Value
Set PlgCibl = Workbooks("Matrice Transposition - Template.xlsx").Worksheets("Reclassement matrice").[D:J]
For L = 1 To 9
   For C = 1 To 7: Ts(1, C) = Te(L + 9 * (C - 1), 1): Next C
   PlgCibl.Rows(4 * (L - 1) + 9).Value = Ts
   Next L
End Sub

Rien à dire Dranred, c'est vraiment top. Merci pour ton aide.

La prochaine fois je posterai avec des fichiers source/résultat, désolé pour la petite perte de temps et la confusion.

Très bonne journée.