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

[Résolu] Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

  • Initiateur de la discussion Initiateur de la discussion exene
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

exene

XLDnaute Accro
Bonjour,

J'utilise une formule proposée par Monique pour calculer le nombre de jours par semaine entre deux dates sans dimanche ni fériés

=($B8<=D$7)*($C8>=D$6)*SOMMEPROD((JOURSEM(LIGNE(INDIRECT(MAX(D$6;$B8)&":"&MIN(D$7;$C8))))>1)*(NB.SI(fer;LIGNE(INDIRECT(MAX(D$6;$B8)&":"&MIN(D$7;$C8))))=0))

Cette formule fonctionne très bien mais est très gourmande en ressources. Comment faudrait il procéder pour utiliser un équivalent en VBA pour traiter un très grand nombre de lignes.

Merci.
 

Pièces jointes

Dernière édition:
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour à tous
trouver sur la toile auteur inconnu
la macro en commentaire sert insérer la fonction automatiquement(pas testé)
Code:
Option Explicit

Function nb_jours_ouvrés(date_début, date_fin) As Integer
    Dim nb_jours_calendaires As Long, nb_jours_non_ouvrés As Long
    Dim date_i As Date
    ' contrôle dates ------------------------------
    If Not IsDate(date_début) Then
        MsgBox "la date début n'est pas une date "
        Exit Function
    End If
    If Not IsDate(date_fin) Then
        MsgBox "la date fin n'est pas une date "
        Exit Function
    End If
    If date_fin < date_début Then
        MsgBox "la date fin n'est pas supérieure à la date début "
        Exit Function
    End If
    
    ' nb jours calendaires ------------------------------
    nb_jours_calendaires = date_fin - date_début
   
    ' détection jours non ouvrés ------------------------------
    nb_jours_non_ouvrés = 0
    For date_i = date_début To date_fin
        If DatePart("w", date_i, vbMonday) = 6 _
        Or DatePart("w", date_i, vbMonday) = 7 _
        Or date_i = premier_jour_année(Year(date_i)) _
        Or date_i = lundi_Paques(Year(date_i)) _
        Or date_i = premier_mai(Year(date_i)) _
        Or date_i = huit_mai(Year(date_i)) _
        Or date_i = jeudi_Ascension(Year(date_i)) _
        Or date_i = lundi_Pentecote(Year(date_i)) _
        Or date_i = fête_nationale(Year(date_i)) _
        Or date_i = onze_novembre(Year(date_i)) _
        Or date_i = noël(Year(date_i)) Then
            nb_jours_non_ouvrés = nb_jours_non_ouvrés + 1
        End If
    Next
    '---------------------------------------------------------------
    
    ' nb jours ouvrés  ------------------------------
    nb_jours_ouvrés = nb_jours_calendaires - nb_jours_non_ouvrés
End Function

Private Function premier_jour_année(année As Integer) As String
premier_jour_année = DateSerial(année, 1, 1)
End Function

Private Function premier_mai(année As Integer) As String
premier_mai = DateSerial(année, 5, 1)
End Function

Private Function huit_mai(année As Integer) As String
huit_mai = DateSerial(année, 5, 8)
End Function

Private Function fête_nationale(année As Integer) As String
fête_nationale = DateSerial(année, 7, 14)
End Function

Private Function onze_novembre(année As Integer) As String
onze_novembre = DateSerial(année, 11, 11)
End Function

Private Function noël(année As Integer) As String
noël = DateSerial(année, 12, 25)
End Function

Private Function lundi_Paques(année As Integer) As String
lundi_Paques = DateAdd("d", 1, date_Paques(année))
End Function

Private Function jeudi_Ascension(année As Integer) As String
jeudi_Ascension = DateAdd("d", 39, date_Paques(année))
End Function

Private Function lundi_Pentecote(année As Integer) As String
lundi_Pentecote = DateAdd("d", 50, date_Paques(année))
End Function
  
Private Function date_Paques(année As Integer) As String
Dim a, b, c, d, e, f, g, h, i, k, l, m, r, mois, jour
    a = année Mod 19
    b = année \ 100
    c = année Mod 100
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    i = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * i - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    r = (114 + h + l - 7 * m)
    mois = r \ 31
    jour = r Mod 31 + 1
    date_Paques = DateSerial(année, mois, jour)
End Function

'Sub macro()
'
'Dim ligne As Range
'
'For Each ligne In ActiveSheet.UsedRange.Rows
'    no_ligne = ligne.Row
'    Columns("K").Rows(no_ligne) = nb_jours_ouvrés(Columns("F").Rows(no_ligne).Value, Columns("G").Rows(no_ligne).Value)
'Next
'
'
'End Sub
'
 
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour, jpb338, le forum,

La macro doit servir à calculer les jours fériés. Je pensais plutôt utiliser la plage nommée fer dans mon exemple. Mon souci est l'utilisation de sommeprod . Je regarde du côté d'Evaluate mais je ne sais pas si cela sera plus rapide. Je crois qu'il faut déclarer un tableau et utiliser Application. WorkSheetFunction .Sumproduct

@+
 
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour à tous,
Salut Pascal,

Pas certain que cela réponde à ta demande mais un essai avec :

Ne compte pas les Samedis et les Dimanches et les Fériés
VB:
Option Explicit

Sub Formule()
    Dim DerL%
    DerL = Sheet1.Range("A65536").End(xlUp).Row

 Sheet1.Range("D5:BE" & DerL).Formula = _
    "=(RC2<=R4C)*(RC3>=R3C)*SUMPRODUCT((WEEKDAY(ROW(INDIRECT(MAX(R3C,RC2)&"":""&MIN(R4C,RC3))))>2)*(COUNTIF(Fer,ROW(INDIRECT(MAX(R3C,RC2)&"":""&MIN(R4C,RC3))))=0))"
    Sheet1.Range("D5:BE" & DerL).Copy
    Sheet1.Range("D5:BE" & DerL).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("D5").Select
End Sub

Ne compte pas les Dimanches et les Fériés
VB:
Option Explicit

Sub Formule()
Dim DerL%
DerL = Sheet1.Range("A65536").End(xlUp).Row

Sheet1.Range("D5:BE" & DerL).Formula = _
"=(RC2<=R4C)*(RC3>=R3C)*SUMPRODUCT((WEEKDAY(ROW(INDIRECT(MAX(R3C,RC2)&"":""&MIN(R4C,RC3))))>1)*(COUNTIF(Fer,ROW(INDIRECT(MAX(R3C,RC2)&"":""&MIN(R4C,RC3))))=0))"
Sheet1.Range("D5:BE" & DerL).Copy
Sheet1.Range("D5:BE" & DerL).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("D5").Select
End Sub

A++
A + à tous
 
Dernière édition:
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour Jean Claude, le forum

Je viens d'essayer ta proposition, malheureusement la macro me retourne le même résultat



Le problème viendrait il de référence relative ?
 

Pièces jointes

  • Capture.JPG
    104 KB · Affichages: 227
  • Capture.JPG
    104 KB · Affichages: 231
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour à tous,

Tu dois être en calcul Manuel.

J'ai modifié la formule pour ne pas compter les Samedis et les Dimanches et supprimé tous tes codes



A + à tous
 

Pièces jointes

  • Capture_1.jpg
    70.2 KB · Affichages: 248
  • Capture_1.jpg
    70.2 KB · Affichages: 248
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

re Bonjour à tous
la foncton nb_jours_ouvrés calcule, comme son nom l'indique, les jours ouvré samedi et dimanche déduit ainsi que les jours fériés
 
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Re,

Bien vu JC, j'étais en calcul manuel pour éviter des recalculs à chaque saisie. Par contre chez moi le samedi est un jour travaillé 🙁. As tu joint un fichier ou modifié le code de ton précédent post ? . Le calcul est vraiment rapide
 
Re : Calculer Nb de jours par semaine entre deux dates sous conditions (VBA)

Bonjour à tous,

Pascal : J'ai édité mon #4 à 10h49 pour répondre à ta demande de10h55.... Arf, Arf...

A++ l'ami
A + à tous
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
362
Réponses
12
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…