Dupliquer une date selon condition
Bonjour,
Je dois créer un planning par trimestre avec des mise en formes conditionnelles diverses (pour identifier jour férié et week-end en les surlignant). J'ai créé des menus déroulants également par sélection de service, trimestre et année. Bon çà et les MFC je sais faire.
Mais je dois également dupliquer les lignes des dimanches et jours fériés, c'est à dire par exemple pour le dimanche 25 JANVIER 2018, je dois me retrouver avec une ligne supplémentaire identique en dessous, et qu'ensuite l'incrémentation de date reprenne.
Évidemment en fonction du trimestre ou de l'année sélectionnée , les dimanches et jours fériés changent de position
En fait la duplication permettrait d'integrer des lignes JOUR et NUIT et seuls les dimanches et les jours fériés sont concernés ( et dupliquer les colonnes ne m'est pas autorisé )
Les jours fériés se trouvent en feuille 2 (par le gestionnaire de nom: ferie)
J'ai essayé par plusieurs formules et impossible de trouver ce qui pourrait fonctionner. J'ai également regarder sur le forum mais n'ai rien trouvé.
J'imagine qu'il faut passer par une macro mais à ce niveau je suis débutant.
Voilà si quelqu'un pouvait m'aider à trouver une solution ( du moins dans un premier temps pour les dimanches)
Merci beaucoup d'avance!
ci-dessous lien du fichier
Bonjour,
Essayer :
Function EstFE(d As Date) As Boolean
If Not [ferie].Find(d, , xlValues) Is Nothing Then EstFE = True
End Function
Sub InserLigneDIFE()
Dim n%, i%, k%
Application.ScreenUpdating = False
With ActiveSheet
For k = 1 To 9 Step 4
n = .Cells(.Rows.Count, k).End(xlUp).Row
For i = n To 19 Step -1
If .Cells(i, k) <> "" Then
If Weekday(.Cells(i, k)) = 1 Or EstFE(.Cells(i, k).Value) Then
.Cells(i + 1, k).Resize(, 4).Insert xlShiftDown
.Cells(i + 1, k).Resize(, 4).Value = .Cells(i, k).Resize(, 4).Value
End If
End If
Next i
Next k
End With
End Sub
Cordialement.
Bonjour MFerrand!
Je vais tester de suite. En tout cas merci beaucoup votre aide!
@MFerrand
Cela fonctionne avec votre fichier de test mais lorsque j'intègre votre macro avec mon fichier ou se trouve mes menus déroulant (j'ai noté que vous les avez supprimé dans votre fichier de test), cela conserve les lignes dupliqués en mémoire à la même position lorsque je change par l'année ou le mois. Si possible il faudrait je pense que cela se réinitialise au changement de l'un des menus déroulant
Est-ce possible?
Merci beaucoup votre aide
@MFerrand
J'ai noté également que la duplication des dimanches et jours fériés ne s'effectuait pas sur les lignes de début de mois (ligne 15,16),
j'ai regardé dans votre code mais ne trouve pas d'ou cela peut provenir,étant débutant en vba
merci
Re,
Le modèle fourni et que j'ai restitué avec macro fonctionne tel que demandé !
Un clic sur le bouton Test insère une ligne sous les jours fériés et les dimanche et ne touche nullement aux listes déroulantes et sans perturber les jours qui suivent !
Cependant il est évident que modifier les valeurs dans les cellules sous listes déroulantes aura des effets pervers en raison des lignes ajoutées !
Soit utilisation d'un modèle sans ligne ajoutée pour changer de trimestre,
soit je te fait une macro pour éliminer les lignes ajoutées si tu utilises la même feuille pour tous les trimestres.
Par ailleurs, les mois sur le modèle commencent ligne 19, la macro s'arrête donc ligne 19 !
Si tu ne fournis pas un modèle conforme, c'est que tu entends adapter !
En effet, je me suis trompé dans mon précédent commentaire
Tout à fait d'accord avec votre commentaire concernant les menus déroulants, j'avais en effet oublié de le préciser
Est-il donc possible d'éliminer les lignes ajoutées comme vous le précisez car je compte utiliser la même feuille pour tous les trimestres?
je vous remercie beaucoup pour votre aide !
Le symétrique pour supprimer...
Sub SuppriLignesSup()
Dim n%, i%, k%
Application.ScreenUpdating = False
With ActiveSheet
For k = 1 To 9 Step 4
n = .Cells(.Rows.Count, k).End(xlUp).Row
For i = n To 19 Step -1
If Not .Cells(i, k).HasFormula Then
.Cells(i, k).Resize(, 4).Delete xlShiftUp
End If
Next i
Next k
End With
End Sub
Et une sécurité pour bloquer les modifs quand des lignes supplémentaires existent:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("N16:N18")) Is Nothing Then
If Me.Range("B29") - Me.Range("B19") < 10 Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End Sub
Cordialement.
Super!
c'est exactement ce qu'il me fallait!
un très, très grand merci MFerrand!