Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

determiner une serie de jours ouvrés avant et après un weekend ou un jour ferié à partir d'une date

Monhtc

XLDnaute Occasionnel
Bonjour chers tous
j'ai besoin d'une aide pour automatiser determiner une serie de jours ouvrés avant et après un weekend ou un jour ferié à partir d'une date début.
EXEMPLE: POUR UNE PERIODE DU 14 FEVRIER AU 01 MARS; COMMENT OBTENIR
PERIODE 1: Date de début: jeudi 14 février - Date de fin: vendredi 15 février
PERIODE 2: Date de début: Lundi 18 février - Date de fin: vendredi 22 février
PERIODE 3: Date de début: lundi 25 février - Date de fin: vendredi 01 mars
 

job75

XLDnaute Barbatruc
Bonjour Monhtc, Pierre,

Je n'avais pas bien compris ni vu qu'il y avait déjà cette discussion :

https://www.excel-downloads.com/threads/determiner-serie-de-periode-de-jours-ouvres.20029038/

Si l'on veut traiter aussi les jours fériés il faut en effet utiliser la fonction SERIE.JOUR.OUVRE, voyez ce fichier (2).

Formule en C4 :
Code:
=SIERREUR(SI(LIGNES(C$4:C4)=1;SERIE.JOUR.OUVRE(C3-1;1;Feries);SERIE.JOUR.OUVRE(C3+6-JOURSEM(C3;2);1;Feries))/(SI(LIGNES(C$4:C4)=1;SERIE.JOUR.OUVRE(C3-1;1;Feries);SERIE.JOUR.OUVRE(C3+6-JOURSEM(C3;2);1;Feries))<=D$3);"")
Formule en D4 :
Code:
=SIERREUR(SI(SERIE.JOUR.OUVRE(C4+6-JOURSEM(C4;2);-1;Feries)>D$3;SERIE.JOUR.OUVRE(D$3+1;-1;Feries);SERIE.JOUR.OUVRE(C4+6-JOURSEM(C4;2);-1;Feries));"")
A+
 

Pièces jointes

  • Périodes(2).xlsx
    16.9 KB · Affichages: 17

Monhtc

XLDnaute Occasionnel
superbe boulot merci Job75 vous êtes un génie. Je viens vous répondre avec ci joint le fichier définitif et le boulot tel que je voudrais le présenter avec la mise en forme
 

Pièces jointes

  • ODM.xlsx
    10.2 KB · Affichages: 15

job75

XLDnaute Barbatruc
Re,

Avant de traiter votre post #5 voici une solution VBA avec cette macro :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim deb As Date, fin As Date, dest As Range, d As Object, dat As Variant, resu(), flag As Boolean, n&
deb = [C3] 'à adapter
fin = [D3] 'à adapter
Set dest = [B3] 'à adapter
'---mémorisation des jours fériés pour accélérer---
Set d = CreateObject("Scripting.Dictionary")
For Each dat In [Feries].Value: d(dat) = "": Next
'---tableau des résultats---
ReDim resu(1 To fin - deb + 1, 1 To 3)
For dat = deb To fin
    If Not flag And Weekday(dat, 2) < 6 And Not d.exists(dat) Then
        flag = True
        n = n + 1
        resu(n, 1) = n
        resu(n, 2) = dat
    End If
    If flag And (Weekday(dat, 2) > 5 Or d.exists(dat)) Then flag = False: resu(n, 3) = dat - 1
Next
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If FilterMode Then ShowAllData 'si la feuille est filtrée
dest(2).Resize(Rows.Count - dest.Row, 3).Delete xlUp 'RAZ
If n Then
    If resu(n, 3) = "" Then resu(n, 3) = fin
    dest(2).Resize(n, 3) = resu
    dest(2, 2).Resize(n, 2).Interior.ColorIndex = 6 'jaune
    dest(2, 2).Resize(n, 2).Borders.Weight = xlHairline 'bordures
End If
Application.EnableEvents = True 'réactive les évènements
End Sub
Elle est mieux que celle de mon post #4 car le 01/05/2019 est exclu des périodes listées.

A+
 

Pièces jointes

  • Périodes VBA(1).xlsm
    24.9 KB · Affichages: 11

job75

XLDnaute Barbatruc
Re,

Voici la macro pour le fichier du post #5 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim deb As Date, fin As Date, dest As Range, d As Object, dat As Variant, resu(), n&, flag As Boolean, i&
deb = [A3] 'à adapter
fin = [A5] 'à adapter
Set dest = [C7] 'à adapter
'---mémorisation des jours fériés pour accélérer---
Set d = CreateObject("Scripting.Dictionary")
For Each dat In [Feries].Value: d(dat) = "": Next
'---tableau des résultats---
ReDim resu(1 To 2 * IIf(fin < deb, 0, fin - deb) + 3, 1 To 3)
n = -1
For dat = deb To fin
    If Not flag And Weekday(dat, 2) < 6 And Not d.exists(dat) Then
        flag = True
        n = n + 2
        resu(n, 1) = "PERIODE " & 1 + (n - 1) / 2
        resu(n, 2) = "DATE DE DEPART"
        resu(n, 3) = dat
        resu(n + 1, 2) = "DATE DE RETOUR"
    End If
    If flag And (Weekday(dat, 2) > 5 Or d.exists(dat)) Then flag = False: resu(n + 1, 3) = dat - 1
Next
If n > -1 Then If resu(n + 1, 3) = "" Then resu(n + 1, 3) = fin
resu(n + 2, 1) = "IMPUTATION BUDGETAIRE"
resu(n + 2, 3) = Application.VLookup("IMPUTATION BUDGETAIRE", dest.EntireColumn.Resize(, 3), 3, 0)
'---restitution---
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
dest(2).Resize(Rows.Count - dest.Row, 3).Delete xlUp 'RAZ
dest(2).Resize(n + 2, 3) = resu
'---fusion des cellules---
If n > 1 Then
    For i = 1 To n Step 2
        dest(i + 1).Resize(2).Merge
        dest(i + 1).VerticalAlignment = xlCenter
    Next
ElseIf n = 1 Then
    dest(2, 2).Resize(2).Cut dest(2)
    dest(2).Resize(, 2).Merge
    dest(3).Resize(, 2).Merge
End If
dest(n + 3).Resize(, 2).Merge 'IMPUTATION BUDGETAIRE
'---bordures---
dest(2).Resize(n + 2, 3).Borders.Weight = xlThin 'bordures
Application.EnableEvents = True 'réactive les évènements
End Sub
Edit 1 : j'ai corrigé le test If n > -1 Then

Edit 2 : dimensionné resu pour le cas où fin < deb.

A+
 

Pièces jointes

  • ODM(1).xlsm
    27.5 KB · Affichages: 5
Dernière édition:

Monhtc

XLDnaute Occasionnel
Bonjour Job75. Merci (x1000) vraiment pour tout à vous Job75. Ça marche nickel tout fonctionne à merveille. Merci pour votre ingéniosité.
J'ai aussi un collègue qui de son coté à monter un formulaire de saisie mais n'a pas réussi à monter les périodes comme vous l'avez fait avec brio.
J'aimerais savoir si c'est aussi possible de faire pareil avec les différents champs:
-DONNE L’ORDRE A (liste déroulante)
-FONCTION (liste déroulante)
-CONTACTS
-D'EFFECTUER UNE MISSION A
-OBJET DE LA MISSION
-MOYEN DE TRANSPORT
-IMPUTATION BUDGÉTAIRE

NB:
la fonction donne l'ordre à et contact marchent comme une recherche, Il suffit de taper l'une de ses informations et les autres infos relatives apparaissent. C'est à dire le nom de l'employé si son contact est tapé ou le numéro (contact) si son nom est tapé.
Je vous remercie de votre attention et votre assistance depuis le début
 

Monhtc

XLDnaute Occasionnel
Encore merci, je ne cesserai de vous dire merci pour votre assistance. En effet j'aimerais crée un formulaire de validation avec les differents champs
UN NUMERO D ORDRE DE MISSION
-DONNE L’ORDRE A (liste déroulante)
-FONCTION (liste déroulante)
-CONTACTS
-D'EFFECTUER UNE MISSION A
-OBJET DE LA MISSION
-MOYEN DE TRANSPORT
-DATE DE DÉPART (Avec les memes calculs de periodes se remplissants automatiquement AVEC LES MISE EN FORME DATE LONGUE)
-DATE DE RETOUR (Avec les memes calculs de periodes se remplissants automatiquement AVEC LES MISE EN FORME DATE LONGUE)
-IMPUTATION BUDGÉTAIRE
Mais aussi avec une base de données sur une autre feuille pour retracer tous les ODM
NB: Une personne peut occuper deux fonctions ou non
 

Pièces jointes

  • ODM(1).xlsm
    31.6 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonjour Monhtc, le forum,

Dans ce fichier (2) je me suis occupé uniquement du transfert de l'ODM dans la feuille BASE DE DONNEES :
Code:
Sub Transfert(dest As Range)
Dim F As Worksheet, lig&, n&, p&
Set dest = dest.Offset(-5) '1ère cellule du tableau
Set F = Feuil3 'CodeName de la feuille BASE DE DONNEES
If F.[G2] = "" Then lig = 2 Else lig = Application.Match(9 ^ 9, F.[G:G]) + 1
For n = 7 To dest.Row + dest.CurrentRegion.Rows.Count - 3 Step 2
    F.Cells(lig + p, 7) = dest(n, 3)
    F.Cells(lig + p, 8) = dest(n + 1, 3)
    p = p + 1
Next
F.Cells(lig, 9).Resize(p) = dest(n, 3)
For n = 1 To 6
    F.Cells(lig, n).Resize(p) = dest(n, 3)
Next
F.[A1].CurrentRegion.RemoveDuplicates _
    Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9), Header:=xlYes 'supprime les doublons
End Sub
L'utilisation de l'UserForm n'est plus le sujet de ce fil et il y a de nombreux exemples sur ce forum, je n'irai donc pas plus loin.

A+
 

Pièces jointes

  • ODM(2).xlsm
    40 KB · Affichages: 4

Monhtc

XLDnaute Occasionnel
Bonsoir Job. Je n'arrive pas à rajouter des lignes encore moins des colonnes à mon classeur. Alors que j'aimerais pouvoir rajouter des logos en haut de part et d'autres afin de personnaliser la mise en forme pour impression.
Merci
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…