Amelioration code trop lent

[Chris401]

Bonjour à tous

Dans le fichier joint, quand je clique sur "Ajouter Semaine" les jours OUVRES de la semaine demandée s'inscrivent en colonne A.

Il y a autant de jours que d'employés ; exemple :
30 employés = 30 lundis, 30 mardis etc ...

La macro fonctionne, mais elle met un certain temps .... et je suis sûr qu'il y a moyen de l'optimiser.

Merci de votre aide.

Cordialement
Chris

 

[Staple1600]

Re : Amelioration code trop lent

Bonjour à tous

Chris401
Ce ne devrait pas être Cdate ici, non ?
' On remplit la colonne A sans les WE et jours fériés
PremLigne = Range("A65536").End(xlUp).Row + 1
Cells(PremLigne, 1) = CVDate(a)
C'est pas vraiment une amélioration, mais cela fait une coquille de moins

Pour l'amélioration voir du côté de l'emploi de cette fonction d'Alain Vallon, retravaillée et soumise par Modeste Geedee.
https://www.excel-downloads.com/threads/calendrier-jours-ouvres-sans-weekend.115076/
(Que tu pourrais utiliser dans ton code, et peut-être coupler avec une MFC)

 

[bof]

Re : Amelioration code trop lent

Bonjour,
Le code modifié (gain de temps 25 à 30 % env.)

Sub LesDates()
Application.ScreenUpdating = False

    Dim nbListe As Integer, j As Integer
    Dim nom
    Dim numSerie As Long, i As Long, PremLigne As Long, Mem&
    Dim J1 As Date
    Dim nbJours As Integer, compteur As Integer
    Dim c As Range
    Dim jFerie As Boolean
    Dim a
    
    If MsgBox("Avez-vous vérifié la liste des employés ?", vbYesNo, "Demande de confirmation") = vbYes Then
    
    ' On met les noms dans un tableau
    nom = Worksheets("Employés").Range("Personnel")
    nbListe = UBound(nom)
          
    a = InputBox("Saisir le LUNDI de la semaine à afficher" _
    & vbCr & "Sous la forme 02/03 (pour le 2 mars " & Year(Date) & ")", "SAISIR DATE")
    
    If a = "" Then End
    'Hdeb = Timer
    a = CDate(a & "/" & Year(Date))
    
    If Weekday(a) <> 2 Then
    MsgBox ("Le " & a & " est un " & UCase(Format(a, "dddd"))) & vbCr & "Recommencez !"
    End
    End If
    
    ' On remplit la colonne A sans les WE et jours fériés
    PremLigne = Range("A65536").End(xlUp).Row + 1
    Mem = PremLigne
      For i = 0 To 4

        Set c = [Feries].Find(CLng(a + i), LookIn:=xlValues)
        If Not c Is Nothing Then jFerie = True
        Set c = Nothing
        If jFerie = False Then
            For j = 1 To nbListe
                Cells(PremLigne, 1) = a + i
                Cells(PremLigne, 2) = nom(j, 1)
                PremLigne = PremLigne + 1
            Next j
        End If
        jFerie = False
    Next i
    Else
    Feuil4.Select
  End If
  
  Call Bordures(Mem)
  'MsgBox Timer - Hdeb
  End Sub

Important : Il a été créé dans la feuille "Base" une plage nommée "Personnel" dans le Gestionnaire de noms.
Cette plage est définie de la manière suivante :
=DECALER(Employés!$A$1;1;;NBVAL(Employés!$A:$A)-1)

A+

 

[Chris401]

Re : Amelioration code trop lent

Bonjour Stapple1600, Bof

@Stapple, j'attaque la lecture du post - Merci beaucoup pour ce lien

@Bof, le code est OK et je t'en remercie ; cependant ça bug sur Call Bordures(Mem)

Cordialement
Chris

 

[Staple1600]

Re : Amelioration code trop lent

Re


Je suppose que bof a modifié plus ou moins ainsi la macro Bordures
Essaies pour voir ce que cela donne

Sub Bordures(L As Long)

'Bordure Rouge entre les jours
Application.ScreenUpdating = False
Dim DerLg As Long
Dim c As Range
DerLg = L 'Range("A" & Rows.Count).End(xlUp).Row
For Each c In Range("A1:A" & DerLg)
With Range(Cells(c.Row, 1), Cells(c.Row, 42))
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
If c.Value <> c.Offset(1, 0).Value Then
With Range(Cells(c.Row, 1), Cells(c.Row, 42))
.Borders(xlEdgeBottom).LineStyle = 5
.Borders(xlEdgeBottom).Weight = 4
.Borders(xlEdgeBottom).ColorIndex = 3
End With
End If
Next c
End Sub

 

[Chris401]

Re : Amelioration code trop lent

Merci Stapple, ça fonctionne

Par contre, maintenant j'ai deux questions :

1 - Puisque Mem = Premligne, pourquoi ne pas écrire Call Bordures(PremLigne)
2 - Dans la macro Bordures, DerLg = L - Comment est calculé L ? Je ne ne trouve pas

Merci de vos réponses
Chris

 

[Staple1600]

Re : Amelioration code trop lent

Re


L=Mem tout simplement.

 

[Chris401]

Re : Amelioration code trop lent

Re

Oui, ça je l'ai compris mais où est-il écrit que L = Mem ?
Bon sang, ça m'énerve de ne pas trouver

Edit : surtout que L peut être n'importe quoi du moment que c'est déclaré

Sub Bordures(V As Long)
...
DerLg = V
...

fonctionne également

Comment DerLg se rapporte à Mem ?


Chris

 

[Staple1600]

Re : Amelioration code trop lent

Re

La modification de Bordures en Bordures(L As Long) transforme ta macro en macro "paramétrée"
où le paramètre L prend la valeur de Mem quand elle appelée par :Call Bordures(Mem)
Mem étant calculé plus haut dans le code soumis par bof.

' On remplit la colonne A sans les WE et jours fériés
    PremLigne = Range("A65536").End(xlUp).Row + 1
    Mem = PremLigne

 

[Chris401]

Re : Amelioration code trop lent

Voilà qui est clair

Merci Stapple

 

[bof]

Re : Amelioration code trop lent

Bonjour,

On a déjà un peu expliqué la subtilité de la macro à paramètre. Voici le "pourquoi" du code original.
La macro modifiée :

Sub Bordures(k&)

'Bordure Rouge entre les jours
Application.ScreenUpdating = False
Dim DerLg As Long
Dim c As Range

DerLg = Range("A" & Rows.Count).End(xlUp).Row

For Each c In Range("A" & k & ":A" & DerLg)
With Range(Cells(c.Row, 1), Cells(c.Row, 42))
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
If c.Value <> c.Offset(1, 0).Value Then
With Range(Cells(c.Row, 1), Cells(c.Row, 42))
.Borders(xlEdgeBottom).LineStyle = 5
.Borders(xlEdgeBottom).Weight = 4
.Borders(xlEdgeBottom).ColorIndex = 3
End With
End If
Next c

End Sub

En fait le MEM (= k) à mémorisé la position de la dernière ligne avant le travail.
Comme ton fichier est très long il est inutile de reformater les quelques milliers de lignes déjà parfaits.
Aussi au lieu de formater à partir de la ligne 1 :
For Each c In Range("A1:A" & DerLg)
Mon code formate uniquement les lignes utiles :
For Each c In Range("A" & k & ":A" & DerLg)
D'où l'utilité du paramètres MEM (k) : 10 % du gain de temps (sur les 25/30% annoncés)


A+

 

[Staple1600]

Re : Amelioration code trop lent

Bonjour bof

Merci pour l'explication. J'étais pas trop loin.

PS: Tu peux appeler "On", Staple, il t'en voudra pas ...

 

[Chris401]

Re : Amelioration code trop lent

Merci Bof pour l'explication

Peux-tu également m'expliquer le pourquoi de Mem puisque Mem=PremLigne ?

On ne peut pas utiliser Call Bordures(PremLigne) ?

Cordialement
Chris

 

[bof]

Re : Amelioration code trop lent

NON !

Mem = PremLigne uniquement quand tu commences le travail, ensuite comme tu rajoutes +1 à chaque tour ton PremLigne devient DernièreLigne... tandis que Mem qui n'est pas dans la boucle conserve sa valeur d'origine.

A+

 

[bof]

Re : Amelioration code trop lent

Bonjour bof

PS: Tu peux appeler "On", Staple, il t'en voudra pas ...

Bonjour Staple,
Sorry, j'ai lu en diagonale, un peu trop d'empressement pour corriger ta macro avant que Chris n'abandonne le fil...
Pas de souçi !

A+