VBA - Copier/coller formule puis valeur
Bonjour à tous,
J'ai élaboré deux codes VBA en creusant par ci, par là; perfectibles je pense pour gagner en rapidité.
Objectif 1er code :
A l'ouverture du fichier, le code va regarder dans une colonne toutes les cellules où "RETARD" est indiqué (cellule calculée vis à vis d'une date fixe et de "AUJOURDHUI()").
Puis va copier/coller une zone contenant des formules, pour chaque ligne où "RETARD" est indiqué, calculer la feuille et enfin copier/coller en valeur (afin que le fichier ne soit pas trop lourd).
La zone a balayer dans le fichier est d'environ 1500 lignes pour la colonnes "RETARD".
Ce code est placé dans "ThisWorkBook" :
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationAutomatic
'Pour chaque plage contenant "RETARD" réalise le copier/coller de la formule permettant la ventilation des heures
Worksheets("Liste_projets").Activate
Dim Plage As Range, Cel As Range
Set Plage = Range([R3], Cells(Rows.Count, "R").End(xlUp))
'on fixe la zone de travail à R3 à dernière non vide en R
For Each Cel In Plage
'pour chaque cellule dans la plage
If Cel = "RETARD" Then
Range("DP3:HG3").Select
Selection.Copy
Cells(Cel.Row, "DP").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Liste_projets").Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If 'fin du test
Next Cel 'cellule suivante
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Enfin le 2ème code a pour objectif de réaliser la même manipulation de copier/coller formule, calculer et enfin copier/coller valeur mais seulement pour les lignes dont les cellules sont sélectionnées et après appui sur un bouton pour lancer la macro.
Sub Ventilation()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Dim Plage As Range, Cel As Range
Set Plage = Selection
'on fixe la zone de travail sur les cellules actives
For Each Cel In Plage
'pour chaque cellule dans la plage
Range("DP3:HG3").Select
Selection.Copy
Cells(Cel.Row, "DP").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Worksheets("Liste_projets").Calculate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next Cel 'cellule suivante
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Les codes fonctionnent, cela dit je pense qu'ils sont perfectibles (la notion de .select) m'a l'air artisanale d'après ce que j'ai pu parcourir... Aussi, est-ce qu'un message box à l'ouverture du fichier montrant l'avancement du processus de calcul de la feuille est faisable ? car à l'ouverture, seul le sablier tourne sans indiquer vraiment ce qu'il se passe
Merci pour votre aide.
Bonjour,
Par rapport aux deux macros que tu as postées ...
Il est vrai que la chose la plus basique à effectuer est de te débarasser des Select ... qui effectivement ne servent à rien ...
Ensuite, tu pourrais envisager pour 1'500 lignes d'adopter une méthode plus performante que la boucle ...
Mais ... une chose après l'autre ...
Il faudrait supprimer les Select et clarifier ta logique actuelle ...
Concernant les Select ... à titre d'exemple :
ces instructions :
Range("DP3:HG3").Select
Selection.Copy
Cells(Cel.Row, "DP").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
peuvent être remplacées par :
Range("DP3:HG3").Copy
Cells(Cel.Row, "DP").PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
Cela étant je ne sais pas ce que contient la plage DP3:HG3 ... et son lien avec chaque cellule de la plage sélectionnée ...
Je ne cacherai pas que joindre un fichier illustratif ... aiderait grandement à la compéhension ...
Bonjour à tous,
Tu peux essayer le code suivant qui réalise le traitement en 2 phases distinctes afin de limiter les pertes de temps en calcul.
Option Explicit
Sub Ventilation()
Dim Plage As Range, Cel As Range
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
'Pour chaque plage contenant "RETARD" réalise le copier/coller de la formule permettant la ventilation des heures
With Worksheets("Liste_projets")
Set Plage = .Range([R3], .Cells(Rows.Count, "R").End(xlUp))
'on fixe la zone de travail à R3 à dernière non vide en R
For Each Cel In Plage
'pour chaque cellule dans la plage
If Cel = "RETARD" Then
.Range("DP3:HG3").Copy
.Cells(Cel.Row, "DP").PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If 'fin du test
Next Cel 'cellule suivante
.Calculate
For Each Cel In Plage
'pour chaque cellule dans la plage
If Cel = "RETARD" Then
.Cells(Cel.Row, "DP").Copy
.Cells(Cel.Row, "DP").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If 'fin du test
Next Cel 'cellule suivante
Application.CutCopyMode = False
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Cordialement.
Merci pour vos retours James007 et Gyrus.
Je vous joints un fichier allégé pour illustrer les zones des formules etc.
@James007 : J'ai remplacé les .select !
Qu'est-ce que l'on pourrait avoir à la place d'une boucle pour balayer la colonne R ?
Les formules en DP3:HG3 vont interagir avec des données contenues dans chaque lignes (volume d'heure, date de début, de fin etc).
@Gyrus : la macro concernant la colonne retard ne doit s'effectuer qu'une seule fois par jour, et à l'ouverture
Ici de ce que je comprends elle se relancerait à chaque fois qu'on lance la macro via le bouton prévu à cet effet.
Re,
Merci pour le fichier qui va certainement éclairer la discussion ...
Félicitations ... si tu t'es déjà débarassé de tous les Select ...
A priori, tu dois déjà avoir constaté une amélioration de la performance de tes macros ...
Concernant les améliorations plus structurelles de tes macros ... je vais d'abord prendre le temps de regarder ton fichier ...
bonjour à tous
mon avis : la mise en lumière de retards ne nécessite pas de copies (je déteste les copies de données, au clavier, ou par VBA)
il suffit de filtrer la table de données sur le mot "RETARD"
s'il y a des formules associées, on ajoute dans le tableau des données une colonne contenant
=SI ( colonneretard = "RETARD" ; formuledontonabesoin ; "" )
ultrasimple, fiable, durable
dans 3 minutes ça marche
amitiés
@jmd
Toutes les lignes ici ont une plage de cellules avec des formules permettant de ventiler un nombre d'heures d'une tâche entre 2 dates.
Avec 1500 lignes contenant cette formule assez lourde (voir la cellule DP3...) et bien il était impossible d'ajouter ou supprimer une ligne sans faire planter excel ou de devoir attendre 15 min à chaque action... le fait de stocker en valeur m’absout de cette lourdeur.
Je retiens ton astuce toutefois pour d'autres cas de figures que je pourrai rencontrer
re
tu as fait trop compliqué selon moi
tu travailles comme sur du papier en rouleau (vers la droite) en 1970
ce qui te crée des tonnes de soucis (et à mon avis pas que pour copier des données et des formules)
fais une véritable table de données pour les congés, et pour les missions
et tout deviendra simple
avec des RECHERCHEV et des TCD
et des graphiques pour "voir" le planning
note : ne JAMAIS fusionner de cellules
amitiés
@Gyrus : la macro concernant la colonne retard ne doit s'effectuer qu'une seule fois par jour, et à l'ouverture
Ici de ce que je comprends elle se relancerait à chaque fois qu'on lance la macro via le bouton prévu à cet effet.
Non, l’idée de fond n’est pas là.
Dans tes procédures, le calcul de la feuille entière est effectué à chaque fois qu’un retard est identifié.
Dans la procédure que je te propose, seul le calcul de la plage copiée est réalisé.
J’ai adapté la procédure Workbook_Open() pour que tu puisses effectuer un test et vérifier si le gain de temps est notable.
Cordialement.
Option Explicit
Sub Workbook_Open()
Dim Plage As Range, Cel As Range
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
'Pour chaque plage contenant "RETARD" réalise le copier/coller de la formule permettant la ventilation des heures
With Worksheets("Liste_projets")
Set Plage = .Range(.Range("R3"), .Cells(.Rows.Count, "R").End(xlUp))
'on fixe la zone de travail à R3 à dernière non vide en R
For Each Cel In Plage
'pour chaque cellule dans la plage
If Cel = "RETARD" Then
.Range("DP3:HG3").Copy
.Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(Cel.Row, "DP").Resize(, 96).Calculate
.Cells(Cel.Row, "DP").Resize(, 96).Copy
.Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If 'fin du test
Next Cel 'cellule suivante
Application.CutCopyMode = False
.Activate
.Range("A1").Select
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Re,
Si l'objectif est d'optimiser ta performance et de remplacer tes boucles sur le champ ' Etat du dossier ' ...par quelque chose de plus efficace ... il faut utiliser AutoFilter ... et de travailler avec la plage de tes cellules visibles ...
Cette approche sera beaucoup plus rapide ... surtout si ta base de données est destinée à grandir et à devenir importante ...
Bonjour,
@gyrus, j'ai testé ta procédure et effectivement le gain de temps est au rendez-vous ! Merci !
J'ai oublié un fait assez important... lors du remplissage des congés il ne se passe plus rien car tout est en valeur...
il faudrait que les lignes affectées à une personne dont les congés ont été mis à jours se calculent.
Comment vous procéderiez ?
J'avais pensé à ça :
Lors de la fermeture de l'outil, une macro copie/colle la colonne E de l'onglet "Congés" (qui indique le total des périodes prises) dans une colonne masquée.
Lors de la modification des congés, la colonne E serait donc différente pour une personne selon les valeurs de la colonne masquée.
Pour chaque ligne dans congés où il y a une différence entre la colonne E et la colonne masquée alors... on stocke le prénom de la personne et on réalise la même macro que pour les "RETARD", puis on passe à la seconde personne etc...
Pour ce cas de figure j'imagine que l'auto filter serait à envisager car beaucoup de lignes à parcourir plusieurs fois (pour une actualisation de toutes les personnes cela reviendrait à lancer la macro de copie de la formule sur tout le classeur...).
Bonjour,
Désolé, je n'ai pas compris ta demande.
Initialement, il s'agissait d'effectuer une mise à jour de la feuille "Liste_projets".
Je ne vois pas le rapport avec les congés.
Ais-je raté un épisode ?
Cordialement.
La formule que l on copie colle prend comme données d entrée les heures de disponibilité des ressources qui est impacté selon un coefficient d absence renseigné.
Donc si on modifie la disponibilité d une personne, la formule devra être recopiée/collée sur les lignes projets où la ressource est affectée.
Je comprends mieux
Une solution serait de détecter les modifications de la plage affectée aux congés (procédure évènementielle CHANGE ciblée sur Congés!F3:CW42) et faire la copie sur les lignes projets où la ressource est affectée.
Par contre, t’es-tu posé la même question pour la feuille Paramètres et la prise en compte de l’année de traitement ? Si le planning est glissant, le problème de mise à jour va se poser.
Bonjour,
Le changement d'année ne devrait pas être gênant (ta remarque m'a bien fait réfléchir ^^).
Je me suis essayé à la fonction "Autofilter"... sans succès, je ne vois pas le problème...
With Worksheets("Liste_projets")
Set Plage = .Range("R3").AutoFilter Field:=1,Criteria1:="RETARD",VisibleDropDown:=False
Autrement j'ai essayé pour les congés modifiés de lancer le code, idem je suis bloqué :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Plage_C As Range, Cel As Range, Nom As Range
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
If Intersect(Target, Range("F3:CW42")) Is Nothing Then Exit Sub
Nom = Application.WorksheetFunction.Match(Target.Value, Worksheets("Congés").Range("B3:B40"), 0)
'Pour chaque plage contenant le nom où les congés ont été modifiés réalise le copier/coller de la formule permettant la ventilation des heures
With Worksheets("Liste_projets")
Set Plage = .Range(.Range("E3"), .Cells(.Rows.Count, "E").End(xlUp))
'on fixe la zone de travail à E3 à dernière non vide en E
For Each Cel In Plage
'pour chaque cellule dans la plage
If Cel = Nom Then
.Range("DP3:HG3").Copy
.Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(Cel.Row, "DP").Resize(, 96).Calculate
.Cells(Cel.Row, "DP").Resize(, 96).Copy
.Cells(Cel.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If 'fin du test
Next Cel 'cellule suivante
Application.CutCopyMode = False
.Activate
.Range("A1").Select
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
End Sub
Si l'autofilter peut faire gagner du temps, je pense que c'est vraiment sur cette étape où il sera pertinent.
Merci pour votre aide encore une fois
Bonjour,
Voici la solution que j’évoquais précédemment.
La procédure Worksheet.Change() se trouve dans le module de la feuille «Congés».
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ressource As String, FirstAddress As String
Dim Plage As Range, C As Range
If Target > 1 Then Exit Sub
If Not Application.Intersect(Target, Range("F3:CW42")) Is Nothing Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Ressource = Cells(Target.Row, 2).Value
With Worksheets("Liste_projets")
Set Plage = .Range(.Range("E9"), .Cells(.Rows.Count, "E").End(xlUp))
Set C = Plage.Find(Ressource, LookIn:=xlValues)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If C.Offset(, 1) <> "" Then
.Range("DP3:HG3").Copy
.Cells(C.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Cells(C.Row, "DP").Resize(, 96).Calculate
.Cells(C.Row, "DP").Resize(, 96).Copy
.Cells(C.Row, "DP").Resize(, 96).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Set C = Plage.FindNext(C)
Loop While Not C Is Nothing And FirstAddress <> C.Address
End If
End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End If
End Sub
Pour la solution avec le filtre auto, je laisse James007 (que je salue) te dévoiler le fond de sa pensée.
Cordialement.
Bonjour gyrus,
Merci merci merci !
Ton code est super ! Le temps de traitement pourrait peut être, via l'idée de James007, être optimisé mais là ça répond clairement à solutionner ma problématique.
En le torturant, j'ai obtenu une erreur lorsque je sélectionne plusieurs cellules et que je supprime les valeurs dans les cellules dans l'onglet congés (suppression en masse suite à erreur de saisie imaginons) :
Erreur d'exécution 13 Incompatibilité de type
[b][color=#FFFF00]If Target > 1 Then[/color][/b] Exit Sub
Aussi, je me suis intéressé aux barres d'avancement, histoire que l'utilisateur sache un peu ce qu'il se passe :
Ci-joint vous trouverez un exemple de barre d'avancement.
Dans le code ci-joint ils utilisent la variable "i" pour faire avancer le compteur, je pensais utiliser la variable "C" du code de worksheet "congés". Seulement le hic, c'est que je ne sais pas comment appeler la private sub de "congés" dans le code du userform.
Promis après je ne vous embête plus
Cordialement.
Bonsoir,
J’ai obtenu une erreur lorsque je sélectionne plusieurs cellules et que je supprime les valeurs dans les cellules dans l'onglet
C’est une erreur de ma part. Cette ligne de code permet justement de s’affranchir des changements multiples.
Il faut écrire :
If Target.Count > 1 Then Exit Sub
Dans le code ci-joint ils utilisent la variable "i" pour faire avancer le compteur, je pensais utiliser la variable "C" du code de worksheet "congés". Seulement le hic, c'est que je ne sais pas comment appeler la private sub de "congés" dans le code du userform.
Dans le code de la barre de progression, i varie de 1 à 100 et correspond au pourcentage de progression. Il est donc prédéfini.
Dans la procédure Worksheet.Change de la feuille Congés, la variable C correspond à chacune des cellules trouvées lors de la recherche du nom de la ressource. Le nombre de cellules trouvées n’est pas prédéfini.
Tu ne peux donc pas utiliser C pour remplacer i.
Cordialement.
Merci Gyrus.
La suppression de plusieurs cellules ne déclenchent plus d'erreur.
Pour l'avancement si je comprends bien il faudrait une variable comme C totalisant le nombre d’occurrences, stocke cette info et l'utilise comme paramètre "i" ?
Le cadre autour de la barre qui se colorie :
Width : 204
Barre qui se colorie
Width : 10
Sub code()
'c'est ici qu'on place son propre code qui doit utiliser le progress indicator
Dim i As Integer, pctCompl As Single
For i = 1 To TotalOccurenceC
Code de la feuille "Congés"
pctCompl = i
progress pctCompl
Next i
End Sub
Sub progress(pctCompl As Single)
UserForm1.Text.Caption = pctCompl*100/TotalOccurenceC & "% Completed"
UserForm1.Bar.Width = pctCompl*100/TotalOccurenceC * 2
DoEvents
End Sub
La démarche serait bonne ?
Pour l'avancement si je comprends bien il faudrait une variable comme C totalisant le nombre d’occurrences, stocke cette info et l'utilise comme paramètre "i" ?
Pour permettre l’affichage de la progression, il faut connaitre au préalable l’occurrence du nom de la ressource. Ce nombre total d’itérations correspondrait au 100% de progression sur la barre. Le calcul du nombre d’occurrences devant être fait avant le traitement de la feuille «Congés», il peut être fait avec la fonction CountIf.
Par contre, ce traitement n’a de sens que si l’occurrence est élevée (et le temps de traitement significatif) sinon la barre de progression va faire une apparition fugace.
Quel est l’ordre de grandeur de l’occurrence et du temps de traitement ?
Cordialement.