Discussion :

[BAHIRI]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

par cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gorfael]

Salut BAHIRI et le forum

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[BAHIRI]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[BAHIRI]

Bonsoir Gorfael,

Je reviens pour 2 points:

1/ Cette ligne de code traitement des formules date:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gorfael]

Salut BAHIRI et le forum

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

="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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Gorfael]

Salut BAHIRI et le forum

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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+

[BAHIRI]

Bonjour Gorfael et Forum,

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


Cordialement