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.