Recherche une commande permettant de suprimer samedi et dimanche dans liste date

cs_hermann28 Messages postés 1 Date d'inscription mercredi 30 septembre 2009 Statut Membre Dernière intervention 27 janvier 2010 - 27 janv. 2010 à 13:01
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 27 janv. 2010 à 14:48
je suis un debutant pour les macros.
on me demande de faire dans une colonne tous les jour ouvres à
partir d'une date en entree!
merci !

5 réponses

Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 71
27 janv. 2010 à 13:13
je résume:

remplir une colonne excel avec toutes les dates inclusent dans un intervalle de dates données, correspondant à un jour ouvré (hors Samedi, dimanche et jours fériés).

tu peux faire cela assez simplement.

le test sur le jour férié peut se faire en utilisant :

www.codyx.org/snippet_calcul-nombre-jours-ouvres-entre-deux-dates_355.aspx#1842



Renfield - Admin CodeS-SourceS - MVP Visual Basic
0
Renfield Messages postés 17287 Date d'inscription mercredi 2 janvier 2002 Statut Modérateur Dernière intervention 27 septembre 2021 71
27 janv. 2010 à 13:21
allez, je te mache le boulot, tache de lire, analyser et comprendre (ou poser des questions si tu ne comprends pas)
Sub test()
    FillRangeWithOpenDates Range("A1"), #1/1/2010#, #12/31/2010#
End Sub

Private Sub FillRangeWithOpenDates(ByVal voTarget As Range, ByVal vdMin As Date, ByVal vdMax As Date)
    If Not Nothing Is voTarget Then
        Set voTarget = voTarget.Offset
        Do While vdMin <= vdMax
            If Not IsHoliday(vdMin) Then
                voTarget.Value = vdMin
                Set voTarget = voTarget.Offset(1)
            End If
            vdMin = vdMin + 1
        Loop
    End If
End Sub

Public Function IsHoliday(ByVal vdInput As Date) As Boolean
Dim nDelta As Long
   If Weekday(vdInput, vbMonday) >= 6 Then
       IsHoliday = True '# Ici, on considère que Samedi et Dimanche sont des jours non ouvrés...
   ElseIf InStr(1, "01/01 01/05 08/05 14/07 15/08 01/11 11/11 25/12", Format$(vdInput, "DD\/MM")) Then
       IsHoliday = True
   Else
        nDelta = DateDiff("D", Easter(Year(vdInput)), vdInput)
        IsHoliday (nDelta 0 Or _
                     nDelta = 1 Or _
                     nDelta = 39 Or _
                     nDelta = 49 Or _
                     nDelta = 50)
   End If
End Function

Public Property Get Easter(ByVal vnYear As Integer) As Date
Dim nE As Integer
Dim nH As Integer
Dim nK As Integer
Dim nP As Integer
Dim nQ As Integer
Dim nI As Integer
Dim nJ As Integer
Dim nGolden As Integer
Dim nCentury As Integer
Dim nCenturyQ As Integer
   nGolden = vnYear Mod 19
   nCentury = vnYear \ 100
   nCenturyQ = nCentury \ 4
   nE = (8 * nCentury + 13) \ 25
   nH = (19 * nGolden + nCentury - nCenturyQ - nE + 15) Mod 30
   nK = nH \ 28
   nP = 29 \ (nH + 1)
   nQ = (21 - nGolden) \ 11
   nI = (nK * nP * nQ - 1) * nK + nH
   nJ = ((vnYear \ 4 + vnYear) + nI + 2 + nCenturyQ - nCentury) Mod 7
   nJ = 28 + nI - nJ
   
   If nJ <= 31 Then
       Easter = DateSerial(vnYear, 3, nJ)
   Else
       Easter = DateSerial(vnYear, 4, nJ - 31)
   End If
End Property



Renfield - Admin CodeS-SourceS - MVP Visual Basic
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
27 janv. 2010 à 14:24
Bonjour,

D'où (une fois de plus) l'intérêt d'ouvrir une discussion dans le thème adéquat.
Celle(-ci aurait dû être ouverte sous le thême VBA (Excel, doté d'une fonction toute indiquée...) ===>> et aurait reçu la proposition suivante :
Private Sub CommandButton3_Click()
  Static toto As Date, titi As String
  datedeb = DateSerial(2010, 1, 27)
  datefin = DateSerial(2010, 2, 3)
  Do While datedeb < datefin
    titi = Application.WorksheetFunction.WorkDay(datedeb - 1, 1)
    If titi <> toto Then MsgBox Format(titi, "dddd dd/mm/yyyy"): toto = titi
    datedeb = datedeb + 1
  Loop
End Sub


où il suffit de remplacer msgbox etc... par autre chose de son choix (et sans formater)...

Ma réponse risque de troubler plus d'un VBiste, si la présente discussion reste où elle est (pas valable sous VB6)!


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
27 janv. 2010 à 14:27
ERugh ..
.
titi as date (bien sûr) et non as string ...



____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 231
27 janv. 2010 à 14:48
Allez ... (moi j'en profite pour continuer mon apprentissage sous VBA/Excel )

Private Sub CommandButton3_Click()
  Dim toto As Date, titi As Date, ou As Integer
  datedeb = DateSerial(2010, 1, 27) ' <<=============ici la date de début
  datefin = DateSerial(2010, 2, 10) ' <<<<<<<=========ici lka date de fin
  Dim zut As Range
  Set zut = Range("C5:C" & datefin - datedeb + ou) ' <<<<<<<<=======on veut afficher à partir de la cellule C5 (exemple)
  ou = zut.Row
  Do While datedeb < datefin
    titi = Application.WorksheetFunction.WorkDay(datedeb - 1, 1)
    If titi <> toto Then zut.Cells(ou - zut.Row + 1, 1).Value titi: ou ou + 1: toto = titi
    datedeb = datedeb + 1
  Loop
End Sub


Essaye ...

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0