Microsoft 365 Procédure trop longue

E

eric72

XLDnaute Accro
Bonsoir à tous,
J'ai un fichier pour gérer un planning dans lequel j'ai créer un code pour dupliquer la saisie sur la tranche horaire qui suit en double cliquant sur les cellules en rose, cela fonctionne bien mais uniquement pour le lundi et le mardi, si j'ajoute les autres jours il me dit que la procédure est trop longue, le souci c'est que je dois le faire sur les 6 jours.
L'un d'entre vous a-t-il une idée sur ce sujet.
Merci beaucoup pour votre dévouement.
Eric
 

Pièces jointes

  • test planning.xlsm
    490.2 KB · Affichages: 10
Solution
TooFatBoy
Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13...
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonsoir,
Désolé, le classeur est trop adhérent au Sharepoint pour pouvoir l'ouvrir correctement sans les autorisations requises .
1689023940214.png


1689023876117.png
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Tes reports de tranche semblent tous identiques, donc un seul devrait suffire, à condition de le paramétrer.

Ainsi, le report
VB: 
    If Not Application.Intersect(Target, Range("d14")) Is Nothing Then
        .Range("h15").Value = .Range("h8").Value
        .Range("h20").Value = .Range("h13").Value
        .Range("b15").Value = .Range("b8").Value
        .Range("c15").Value = .Range("c8").Value
        .Range("d15").Value = .Range("d8").Value
        .Range("e15").Value = .Range("e8").Value
        .Range("e20").Value = .Range("e13").Value
        .Range("e21").Value = .Range("e14").Value
    End If

deviendrait simplement
VB: 
    If Target = .Range("d14") Then Report Target

Avec la macro Report :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Pour résumer :

Ajouter une procédure paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub

Et pour le lundi il ne reste plus que ceci (qui doit encore être simplifiable) :
VB: 
    '***********************************************
    ' Début Report Tranche LUNDI
  
    ' Equipe 1
    If Not Application.Intersect(Target, .Range("D14,D21,D28,D35,D42,D49,D56")) Is Nothing Then Report Target

    ' Equipe 2
    If Not Application.Intersect(Target, .Range("D70,D77,D84,D91,D98,D105,D112")) Is Nothing Then Report Target

    ' Equipe 3
    If Not Application.Intersect(Target, .Range("D126,D133,D140,D147,D154,D161,D168")) Is Nothing Then Report Target

    ' Equipe 4
    If Not Application.Intersect(Target, .Range("D182,D189,D196,D203,D210,D217,D224")) Is Nothing Then Report Target

    ' Equipe 5
    If Not Application.Intersect(Target, .Range("D238,D245,D252,D259,D266,D273,D280")) Is Nothing Then Report Target

    ' Equipe 6
    If Not Application.Intersect(Target, .Range("D294,D301,D308,D315,D322,D329,D336")) Is Nothing Then Report Target

    ' Equipe 7
    If Not Application.Intersect(Target, .Range("D350,D357,D364,D371,D378,D385,D392")) Is Nothing Then Report Target

    ' Equipe 8
    If Not Application.Intersect(Target, .Range("D406,D413,D420,D427,D434,D441,D448")) Is Nothing Then Report Target

    ' Fin Report Tranche LUNDI
    '***********************************************
 
Dernière édition:
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub

La macro d'origine serait alors plus courte :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la colonne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True
        Report Target

    End With

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Solution
E

eric72

XLDnaute Accro
TooFatBoy à dit:
Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub

La macro d'origine serait alors plus courte :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la ligne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True
        Report Target

    End With

End Sub
Cliquez pour agrandir...

TooFatBoy à dit:
Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub

La macro d'origine serait alors plus courte :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la ligne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True
        Report Target

    End With

End Sub
Cliquez pour agrandir...
Bonjour à tous,
Tout d'ab
TooFatBoy à dit:
Sous réserve de m'être trompé, on doit pouvoir simplifier un peu plus.

On aurait toujours la macro paramétrée :
VB: 
Sub Report(CelRef As Range)

    Application.ScreenUpdating = False

    With CelRef                                         ' Exemple pour D14
        .Offset(1, 4).Value = .Offset(-6, 4).Value      ' H15 = H8
        .Offset(6, 4).Value = .Offset(-1, 4).Value      ' H20 = H13
        .Offset(1, -2).Value = .Offset(-6, -2).Value    ' B15 = B8
        .Offset(1, -1).Value = .Offset(-6, -1).Value    ' C15 = C8
        .Offset(1, 0).Value = .Offset(-6, 0).Value      ' D15 = D8
        .Offset(1, 1).Value = .Offset(-6, 1).Value      ' E15 = E8
        .Offset(6, 1).Value = .Offset(-1, 1).Value      ' E20 = E13
        .Offset(7, 1).Value = .Offset(0, 1).Value       ' E21 = E14
    End With

End Sub

La macro d'origine serait alors plus courte :
VB: 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    With Target

        ' Vérification de la validité de la ligne
        If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

        ' Vérification de la validité de la ligne
        If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub

        Cancel = True
        Report Target

    End With

End Sub
Cliquez pour agrandir...
Bonjour à tous,
Tout d'abord merci pour vos réponse, je remets le fichier pour Franch.
TooFatBoy, j'ai regardé vos réponses, je vais essayer de l'adapter mais pas avant cet après-midi, je vous dirai si cela fonctionne mais j'avoue que je n'ai pas bien compris. Je vous tiens au courant.
Merci encore pour avoir pris le temps de regarder mon problème.
 

Pièces jointes

  • test planning.xlsm
    363.9 KB · Affichages: 1
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
En fait ce que je ne comprends pas dans le code c'est ça:
' Vérification de la validité de la ligne
If ((.Row Mod 7) <> 0) Or (.Row > 448) Or ((((.Row / 7) - 1) Mod 8) = 0) Then Exit Sub

' Vérification de la validité de la ligne
If (((.Column + 8) Mod 12) <> 0) Or (.Column > 64) Then Exit Sub
je ne sais pas à quoi cela correspond!!!
Merci
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Code: 
(.Row Mod 7) <> 0

.Row, c'est en fait Target.Row, c'est le numéro de ligne de la cellule double-cliquée.

Target.Row Mod 7 donne la congruence du numéro de la ligne double-cliquée modulo 7.
C'est-à-dire qu'on regarde le reste de la division du numéro de la ligne double-cliquée par 7.
Ligne 1 donne 1, ligne 2 donne 2, ... , ligne 6 donne 6, ligne 7 donne 0, ligne 8 donne 1, ligne 9 donne 2, etc.

Donc si Target.Row Mod 7 donne 0, ça veut dire que le numéro de ligne de la cellule double-cliquée est un multiple de 7 (et c'est justement ce qu'on veut : ligne 14, 21, 28, 35, etc.).
Donc si Target.Row Mod 7 est différent de zéro, ça ne nous intéresse pas, donc on sort de la macro (Exit Sub) sans faire quoi que ce soit.


Pour résumer :
Si le numéro de ligne de la cellule double-cliquée n'est pas un multiple de 7, on quitte la macro.


Mine de rien on vient ainsi d'éliminer presque 86 % des cas possibles. 😉


Ce début d'explication est-il suffisamment clair ?
 
Dernière édition:
Vote positif 0 Vote négatif
E

eric72

XLDnaute Accro
rE
TooFatBoy à dit:
Code: 
(.Row Mod 7) <> 0

.Row, c'est en fait Target.Row, c'est le numéro de ligne de la cellule double-cliquée.

Target.Row Mod 7 donne la congruence du numéro de la ligne double-cliquée modulo 7.
C'est-à-dire qu'on regarde le reste de la division du numéro de la ligne double-cliquée par 7.
Ligne 1 donne 1, ligne 2 donne 2, ... , ligne 6 donne 6, ligne 7 donne 0, ligne 8 donne 1, ligne 9 donne 2, etc.

Donc si Target.Row Mod 7 donne 0, ça veut dire que le numéro de ligne de la cellule double-cliquée est un multiple de 7 (et c'est justement ce qu'on veut : ligne 14, 21, 28, 35, etc.).
Donc si Target.Row Mod 7 est différent de zéro, ça ne nous intéresse pas, donc on sort de la macro (Exit Sub) sans faire quoi que ce soit.


Pour résumer :
Si le numéro de ligne de la cellule double-cliquée n'est pas un multiple de 7, on quitte la macro.


Mine de rien on vient ainsi d'éliminer presque 86 % des cas possibles. 😉


Ce début d'explication est-il suffisamment clair ?
Cliquez pour agrandir...
Re Bonjour,
L'explication est top, la seule chose que j'ai compris c'est le résumé:
Si le numéro de ligne de la cellule double-cliquée n'est pas un multiple de 7, on quitte la macro.
C'est déjà bien , lol!!!
J'ai un autre problème de lenteur mais il faut peut-être que je crée un nouveau post?
En fait j'aimerais archiver par date (dans une autre feuille) quand je choisis une semaine en AA4 et que je remplis mon planning, puis a chaque fois que je choisis à nouveau cette semaine récupérer ma saisie d'origine.
J'y arrive sauf que pour récupérer les données saisies c'est un peu long (pas étonnant vu ma manière de coder)
Quoi qu'il en soit, merci 1000 fois pour ton aide.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Je continu mon explication...

Si on est encore dans la macro, ça veut dire que le numéro de ligne est un multiple de 7, mais tous les multiples de 7 ne nous intéressent pas (par exemple la ligne 7000).

La dernière ligne qui nous intéresse est la ligne 448 (448 = 7×64).
Donc si le numéro de ligne est strictement supérieur à 448, on sort de la macro.

Mine de rien maintenant on sait qu'on a double-cliqué sur une des 64 lignes multiple de 7 et inférieure ou égale à 448.
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Et pour finir... ;)

Les 64 lignes ne nous intéressent pas toutes.
Par exemple la ligne 7 à beau être un multiple de 7 et inférieure ou égale à 448, elle ne nous intéresse pas, donc il faut ajouter une troisième condition pour éliminer ces lignes qui ne nous intéressent pas.

C'est ce que fait la troisième condition du code :
(((.Row / 7) - 1) Mod 8) = 0


Ainsi il ne nous reste plus que les lignes qui nous intéressent.


Ensuite on suit exactement le même raisonnement pour les colonnes.

Et au final, il ne nous reste que les cellules qui nous intéressent.
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
XL pour MAC Répartir des personnes dans des équipes par roulement sur 5 jours
Réponses
6
Affichages
654
job75
job75
D
  • Question
XL 2021 report automatique de donnees
Réponses
3
Affichages
231
DomL
D
L
  • Question
Microsoft 365 [Excel] GCD pour centre d'appel
Réponses
5
Affichages
249
Loow76
L
E
  • Résolu(e)
Microsoft 365 Convertir en -tete tableau en date
Réponses
14
Affichages
591
eric72
E
Y
  • Question
XL 2013 Récupérer les bornes d'une chronologie
Réponses
0
Affichages
402
Yvan1
Y
M
  • Résolu(e)
XL 2021 Planning
2 3
Réponses
40
Affichages
2 K
Moran56
M
E
  • Résolu(e)
Microsoft 365 Couleur Police sur grand nombre de cellules
2
Réponses
22
Affichages
790
TooFatBoy
TooFatBoy
E
  • Résolu(e)
Microsoft 365 Planning hebdo
2
Réponses
20
Affichages
1 K
eric72
E
E
  • Résolu(e)
Microsoft 365 Recupération Données
Réponses
5
Affichages
348
eric72
E
A
  • Question
XL 2016 Contrôle de la pose de 10 jours de congés consécutifs
Réponses
5
Affichages
633
djidji59430
djidji59430

Membres actuellement en ligne

5 membres et 97 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 486
Messages
2 110 107
Membres
110 666
dernier inscrit
Yaya123