Code à optimiser

Version imprimable

Code à optimiser

Bonjour à tous,

Je vous prie de m'indiquer si le code que je viens de rédiger est optimisé ?. Il y a certainement des éléments à corriger.

Le code effectue les opérations demandées :

- Copie d'une date saisie
- Insertion de fonctions pour extraire le nom du jour, le numéro de la seamine et le mois.

Merci par avance pour vos observations

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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub Boucle()
Dim L As Integer
Dim C As Integer
Dim Cpt As Integer
Dim Ld As Integer
Dim Cd As Integer
 
Ld = 2
Cd = 3
L = 2
C = 3
 
Set code = Range("A2", [A2].End(xlDown))
NBRLIGNES = code.Count
 
    Cells(L, C).Select
    Cells(L, C).Value = Application.InputBox("A l'attention de l'utilisateur")
 
     'copie de la date dans la colonne date
        Cells(Ld, Cd).Select
        Selection.Copy
 
         Application.ScreenUpdating = False
         For CptDate = 1 To NBRLIGNES
 
                Selection.Copy
                Cells(Ld, Cd).Select
                ActiveSheet.Paste
                Ld = Ld + 1
         Next CptDate
 
    Application.ScreenUpdating = False
    For Cpt = 1 To NBRLIGNES
 
    'traitement des formules date
        Cells(L, C + 1).Select
        ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")"
 
        Cells(L, C + 2).Select
        ActiveCell.FormulaR1C1 = "=NO.SEMAINE(RC[-2],2)"
 
        Cells(L, C + 3).Select
        ActiveCell.FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")"
 
 
        L = L + 1
 
 
     Next Cpt
 
        Application.CutCopyMode = False
 
End Sub

28/06/2009, 11h24
Jean-Philippe André
salut,
par habitude, mets un option explicit en haut de ton code => Code n'est pas une variable déclarée

tu peux simplifier ceci
Code:

1 2 Cells(L, C + 1).Select ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")"
par cela

Code:

Cells(L, C + 1).FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")"

Salut BAHIRI et le forum

Citation:

Je vous prie de m'indiquer si le code que je viens de rédiger est optimisé ?. Il y a certainement des éléments à corriger.

Celà sous-entend qu'il fonctionne comme tu veux, et j'ai des doutes.
Code:

1 2 3 4 5 6 7 8 9 10 11 Sub Boucle() Dim L As Integer Dim C As Integer Dim Cpt As Integer Dim Ld As Integer Dim Cd As Integer Ld = 2 Cd = 3 L = 2 C = 3
C'est bien de déclarer tes variables (quoique je préfère déclarer les lignes en Long). Mais pourquoi ne pas déclarer toutes tes variables ?
Code:

1 2 Set code = Range("A2", [A2].End(xlDown)) NBRLIGNES = code.Count
Je n'aime pas utiliser un (xldown), les résultats sont différents si les 2 premières ne sont pas identiques (pleines ou vides) et s'il y a une cellule vide entre la première et la dernière non vide... Mais chacun son code.
Se servir de mots, pouvant être utilisés par Excel, comme nom de variable est loin d'être la meilleure idée.

Code:

NBRLIGNES = Range("A2", [A2].End(xlDown))

Code:

Cells(L, C) = Application.InputBox("A l'attention de l'utilisateur")

on remplit C2 avec la demande. Jusqu'à là, je comprends.
Code:

1 2 3 4 5 Application.ScreenUpdating = False For CptDate = 1 To NBRLIGNES Cells(Ld, Cd).Copy Cells(Ld, Cd) Ld = Ld + 1 Next CptDate
Oui, je sais, ça fait bizarre, mais c'est ton code optimisé. Tu veux faire quoi ? Parce que recopier les cellules de C sur C, il y a plus rapide, et ça ne sert toujours à rien.
Donc, je te conseillerais de dire exactement ce que tu veux faire, qu'on comprenne ce que le code doit faire, et pas un texte général qui ne justifie aucune boucle.

Blocage du rafraîchissement d'écran : pourquoi seulement sur cette boucle ? fais-le pour toute ta macro. en mettant screenupdating à false au déprt et True en quittant.
Code:

1 2 3 4 5 6 7 8 Application.ScreenUpdating = False For Cpt = 1 To NBRLIGNES 'traitement des formules date Cells(L, C + 1).FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")" L = L + 1 Next Cpt Application.CutCopyMode = False End Sub
fonctionne, à mon étonnement (quoique comme on est en R1C1...), mais il y a plus rapide :
Code:

1 2 3 4 5 6 7 8 'traitement des formules date Cells(L, C + 1).FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")" Cells(L, C + 2).FormulaR1C1 = "=NO.SEMAINE(RC[-2],2)" Cells(L, C + 3).FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")" Range(Cells(L, C + 1), Cells(L, C + 3)).AutoFill Range(Cells(L, C + 1), Cells(L + nbrlignes - 1, C + 3)) Application.CutCopyMode = False Application.ScreenUpdating = False End Sub
A+

Bonsoir Gorfael

Comme tu l’as constaté, le code commence par la saisie d'une date grâce à l'Input Box. C’est une solution temporaire en attendant le traitement suivant.
En effet, cette date est indiquée dans le nom du fichier " ex090306.xls ". À partir de ce classeur je copie le contenu d'une plage de 2483 lignes (variable) en date du 06 MARS 09.
L'objectif est d'exploiter le nom des fichiers "ex090306.xls" dans un répertoire pour traiter le fichier suivant "ex090307.xls" (du jour suivant puis le mois suivant). Le contenu de celui-ci doit s’ajouter à la suite (après la 2483ièm ligne).
"03 mardi 10 MARS" doivent être copié 2483 fois (la taille de la plage fournie par la variable ID_agent).
Je ne sais pas si je suis claire dans mes explications.
Merci pour votre aide.

Cordialement

Code :
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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 Option Explicit Sub DJSMKBI() Dim L As Integer, C As Integer, Cpt As Integer, Ld As Integer, Cd As Integer Dim CptDate As Integer, NBRLIGNES As Integer, ID_agent As Range Ld = 2 Cd = 3 L = 2 C = 3 Set ID_agent = Range("A2", [A2].End(xlDown)) NBRLIGNES = ID_agent.Count Cells(L, C).Select Cells(L, C).Value = Application.InputBox("Saisir une date sous forme JJ MMMM ") 'copie de la date dans la colonne date Cells(Ld, Cd).Select Selection.Copy Application.ScreenUpdating = False For CptDate = 1 To NBRLIGNES Selection.Copy Cells(Ld, Cd).Select ActiveSheet.Paste Ld = Ld + 1 Next CptDate Application.ScreenUpdating = False 'traitement des formules date Cells(L, C + 1).FormulaR1C1 = "=TEXT(RC[-1],""jjjj"")" Cells(L, C + 2).FormulaR1C1 = "=NO.SEMAINE(RC[-2],2)" Cells(L, C + 3).FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")" Range(Cells(L, C + 1), Cells(L, C + 3)).AutoFill Range(Cells(L, C + 1), Cells(L + NBRLIGNES - 1, C + 3)) L = L + 1 Application.CutCopyMode = False Application.ScreenUpdating = False End Sub

06/07/2009, 01h08
BAHIRI
Bonsoir Gorfael,

Je reviens pour 2 points:

1/ Cette ligne de code traitement des formules date:
Code:

1 2 Range(Cells(L, C + 1), Cells(L, C + 3)).AutoFill Range(Cells(L, C + 1), Cells(L + NBRLIGNES - 1, C + 3)) L = L + 1
J’ai essayé de l’adapter pour copier la date saisie via l’Input Box mais sans succès. Probablement je ne l’ai probablement pas comprise.

2/ Je ne sais pas comment extraire la date du nom des fichiers "ex090306.xls" pour les traiter sans passer par Input Box. Cette dernière partie je compte la mettre dans une procédure de Mise à jour pour continuer le traitement via l’Input box.

Merci ton aide
06/07/2009, 04h43
Gorfael
Salut BAHIRI et le forum
Code:

1 2 Range(Cells(L, C + 1), Cells(L, C + 3)).AutoFill Range(Cells(L, C + 1), Cells(L + NBRLIGNES - 1, C + 3)) L = L + 1
tu dois copier la date de la cellule Cells(L,C) à la cellule Cells(L+NBRLIGNES-1,C) (NBRLIGNES contient la ligne L, donc, il faut retirer 1).
Quand on a mis les 3 formules, on fait comme si manuellement :
- on sélectionne ligne L les colonnes C+1 à C+3
- on tire la petite croix noire en bas à droite. Ce qui rempli les trois colonnes de L à la ligne de la dernière date, en adaptant les formules qui sont données en adressage relatif

Citation:

J’ai essayé de l’adapter pour copier la date saisie via l’Input Box mais sans succès. Probablement je ne l’ai probablement pas comprise

. Tu as la date en Cells(L,C) Il faut simuler un remplissage (avec la petite croix noire+<Ctrl>)

Code:

Cells(L,C)AutoFill Destination:=Range(Cells(L,C),Cells(L+NBRLIGNES-1,C)), Type:=xlFillCopy

Citation:

Je ne sais pas comment extraire la date du nom des fichiers "ex090306.xls" pour les traiter sans passer par Input Box.

Workbooks.name = "ex090306.xls"
comme on veut trouver les fichier, donc, il faut créer le nom, à partir d'une date. La premirère Date est en Cells(L,C)
Le nom du fichier sera donc

Code:

="ex" & format(cells(L,C), "yymmdd") & ".xls"

Le jour d'après (y compris avec un changement de mois)

Code:

="ex" & format(cells(L,C)+1, "yymmdd") & ".xls"

etc.
je te conseillerais une boucle pour les dates, et une seule opération pour les autofill :

Code:

Range(Cells(L, C + 1), Cells(L, C + 3)).AutoFill Range(Cells(L, C + 1), Cells(Cells(Rows.Count, C).End(xlUp).Row, C + 3))

A+
11/07/2009, 01h33
BAHIRI

Bonjour Gorfael,
Je reviens tout d'abord pour te remercier pour tes explications et pour te demander des précisions.

Tu me conseilles une boucle pour les dates et une seule opération pour les Autofill. Je ne comprends pas car le code ci-dessous doit copier en une seule opération la date dans la plage qui va de Cells(L, C) à NBRLIGNES:

Code:

Cells(L, C).AutoFill Destination:=Range(Cells(L, C), Cells(L + NBRLIGNES - 1, C), Type:=xlFillCopy)

De plus, le code ne s'execute pas à cause d'un problème d'affectation de l'objet Range.

Merci par avance de pour ton aide.

Cordialement
11/07/2009, 13h40
Gorfael
Salut BAHIRI et le forum

Code:

Cells(L, C).AutoFill Destination:=Range(Cells(L, C), Cells(L + NBRLIGNES - 1, C)), Type:=xlFillCopy

La place de la dernière parenthèse fermante n'est pas la bonne : elle doit clôturer l'objet range.

Je te conseille une boucle pour les dates : pour la "saisie" des dates. un truc du genre :
Code:

1 2 3 4 5 6 Sub test() Dim Date_Ref As Date For Date_Ref = DateSerial(2008, 3, 5) To DateSerial(2008, 6, 10) 'traitement Next Date_Ref End Sub
qui crée les jours du 5 mars au 10 juin (dans l'exemple).
A+
20/12/2009, 09h38
BAHIRI

Bonjour Gorfael et Forum,

Merci pour tes solutions très didactiques. je reprend la logique te ton code pour continuer.

Cordialement