VBA - Copier/coller formule puis valeur
J'ai chronométré sur le fichier complet :
A l'ouverture du fichier : 75 lignes "RETARD" donnent 12 secondes.
Et lors d'un changement de congés pour la ressource qui est la plus "citée", soit 88 lignes j'obtiens environ 21 secondes.
J'ai intégré le countif, et modifié les avancements de la barre pour que cela s'adapte quelque soit le nombre retourné par countif.
Dans le fichier ci-joint j'ai essayé de calquer au langage de la macro à l'ouverture du fichier pour les mots "retard", notamment au niveau de la range de comptage.
Je m'interroge quant à l'incorporation à la macro complète : où placer les lignes de code de la barre d'avancement ? et également comment faire pour que cette barre de progression se déclenche pour 2 événements ? :
1) ouverture du fichier et calcul de tous les "RETARD" puis application formule
2) modification des dispos d'une personne, dans ce cas le "RETARD" devient le "C"
Bonjour,
J’ai effectué une adaptation de la procédure de la feuille « Congés » pour intégrer une barre de progression. Je te laisse le loisir d’effectuer les tests sur ton fichier.
Tu pourras l’adapter si tu veux l’appliquer également à l’ouverture du classeur pour les retards.
Cordialement.
Bonsoir Gyrus,
Merci pour ton implication
J'ai testé et j'ai compris que l'occurrence avait une importance d'après ton code.
En testant sur une ressource qui finalement avait 177 fois son nom de cité, j'ai vu que l'avancement en % atteignait 177% et pour une qui n'en avait que 10, le compteur ne décolle pas et la fenêtre se ferme rapidement.
Pas = Totaloccurence / Totaloccurence
Progression = Progression + Pas
UserForm1.Bar.Width = (Progression + Pas) / Totaloccurence * 100 * 2
UserForm1.Text.Caption = "Progression " & Int((Progression + Pas) / Totaloccurence * 100) & "%"
DoEvents
En comprenant bien ton code, j'ai pu via le code ci-dessus, faire que l'avancement soit tjrs bon quelque soit le nombre d'occurences.
L'affichage fonctionnant mieux sur les grandes occurences que sur les très faibles (inférieure à 10, l'affichage est rapide ce qui est normal mais l'affichage indique en bout de course "125%" avant de disparaître ^^).
Je décroche pour ce soir mais demain j'essaye de transcrire cette merveille pour les "RETARD".
Merci encore gyrus !
Bonne soirée.
Bonsoir Gyrus,
Je crois que j'y suis... et grâce à toi ! Merci énormément.
Pour le code à l'ouverture voilà ce que cela donne :
Option Explicit
Sub Workbook_Open()
'MACRO : Pour chaque plage contenant "RETARD" réalise le copier/coller de la formule permettant la ventilation des heures
Dim Plage As Range, Cel As Range, Totaloccurence As Integer, Progression As Integer, Pas As Double
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With Worksheets("Liste_projets")
'on fixe la zone de travail à R3 à dernière non vide en R
Set Plage = .Range(.Range("R3"), .Cells(.Rows.Count, "R").End(xlUp))
'on calcule le nombre total d'occurences de RETARD sur la plage
Totaloccurence = Application.WorksheetFunction.CountIf(Plage, "RETARD")
UserForm1.Show 0
Progression = 0
'pour chaque cellule dans la plage
For Each Cel In Plage
Pas = Totaloccurence / Totaloccurence 'détermination du pas
UserForm1.Bar.Width = (Progression + Pas) / Totaloccurence * 100 * 2 'avancement de la barre
UserForm1.Text.Caption = "Progression " & Int((Progression + Pas) / Totaloccurence * 100) & "%" 'avancement du texte de la barre
DoEvents 'réaliser l'évènement
If Cel = "RETARD" Then 'si la cellule contient "RETARD" alors
Progression = Progression + Pas 'incrémentation de progression
.Range("DP3:HG3").Copy 'copie la range contenant les formules
.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
End With
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Unload UserForm1 'fermeture de l'userform
End Sub
Vraiment super... merci beaucoup !!!
Résolu !