Microsoft 365 MACRO Remplacer date si jour non ouvré remplace par jour ouvré précédent

chris6999

XLDnaute Impliqué
Bonjour

Je cherche un code qui passerait sur une plage de dates (ColB) et qui, si la date est un jour non ouvré, remplace par le 1er jour ouvré précédent.
Ex si date correspond à un samedi ou un dimanche remplace par la date du vendredi.
SI jour férié vendredi remplace par jeudi.

Le but est de traiter la colonne directement et de ne pas utiliser les autres colonnes.

Merci par avance pour votre aide.

Bonne journée
 

Pièces jointes

  • macro test remplace jour non ouvré par jour ouvré précédent.xlsm
    18.4 KB · Affichages: 6

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Chris, JHA,
Un essai en PJ avec :
VB:
Sub SupprimeWE()
    Dim L%
    Application.ScreenUpdating = False
    For L = 7 To Range("B65500").End(xlUp).Row
        Select Case Weekday(Cells(L, "B"), vbMonday)
            Case 6: Cells(L, "B") = Cells(L, "B") - 1
            Case 7: Cells(L, "B") = Cells(L, "B") - 2
        End Select
    Next L
End Sub
 

Pièces jointes

  • macro test remplace jour non ouvré par jour ouvré précédent.xlsm
    20.7 KB · Affichages: 7

sylvanu

XLDnaute Barbatruc
Supporter XLD
Oups, j'avais zappé. Merci JHA.
Un PJ 2 avec :
VB:
Sub SupprimeWE()
    Dim L%
    [P1] = Year([B7])   ' Met à jour l'année pour le calcul des jours fériés.
    Application.ScreenUpdating = False
    For L = 7 To Range("B65500").End(xlUp).Row
        Select Case Weekday(Cells(L, "B"), vbMonday)
            Case 6:
                Cells(L, "B") = Cells(L, "B") - 1
            Case 7: Cells(L, "B") = Cells(L, "B") - 2
        End Select
        If Application.CountIf([Férié], Cells(L, "B")) > 0 Then
            Cells(L, "B") = Application.Index([Remplacé], Application.Match(Cells(L, "B"), [Férié], 0))
        End If
    Next L
End Sub
J'ai mis la liste des fériés sur 2 ans si la liste des dates est à cheval.
 

Pièces jointes

  • macro test remplace jour non ouvré par jour ouvré précédent (V2).xlsm
    26.9 KB · Affichages: 2

chris6999

XLDnaute Impliqué
Bonjour Chris, JHA,
Un essai en PJ avec :
VB:
Sub SupprimeWE()
    Dim L%
    Application.ScreenUpdating = False
    For L = 7 To Range("B65500").End(xlUp).Row
        Select Case Weekday(Cells(L, "B"), vbMonday)
            Case 6: Cells(L, "B") = Cells(L, "B") - 1
            Case 7: Cells(L, "B") = Cells(L, "B") - 2
        End Select
    Next L
End Sub
Bonjour et merci Sylvanu.
Cela fonctionne nickel et en plus le traitement est très rapide
Je vais essayer d'adapter le code à mon projet.

Bonne journée
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Je vais essayer d'adapter le code à mon projet.
Sorry il y a un petit bug dans la version V2 concernant la pentecôte et le lundi de pentecôte.

Donc voici une nouvelle version, tout en VBA ( la liste des fériés dans la page me "dérangeait"
La macro utilise deux fonctions perso ( dans le module GereJoursFeries )
1- JourFérié(Madate) revoie vide si non férié, renvoie une chaine si férié.
2- JourOuvréAprèsJourFérié(MaDate) renvoie le même jour si non férié, sinon Madate-1 ou -3 si férié.
Donc dans votre dossier il faut importer les deux modules GereJoursFeries et SupprimeWeekEnd
Sur mon PC, cela gère tout 2023 en 40ms.
 

Pièces jointes

  • macro test remplace jour non ouvré par jour ouvré précédent (V3).xlsm
    29.2 KB · Affichages: 1

Discussions similaires

Réponses
2
Affichages
224