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

[chris6999]

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

 

[JHA]

Bonjour à tous,

Un début de piste par formule, à toi de retranscrire en VBA car je ne sais pas faire.

JHA

 

[sylvanu]

Bonjour Chris, JHA,
Un essai en PJ avec :

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

 

[JHA]

Bonjour @sylvanu

Cela parait tellement simple avec VBA
Il te manque l'option des fériés dans ton exemple.

JHA

 

[sylvanu]

Oups, j'avais zappé. Merci JHA.
Un PJ 2 avec :

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.

 

[chris6999]

Bonjour Chris, JHA,
Un essai en PJ avec :

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

 

[chris6999]

Bonjour à tous,

Un début de piste par formule, à toi de retranscrire en VBA car je ne sais pas faire.

JHA

Merci pour ta proposition mais c'est bien le code que je recherchais car je connais déjà les fonctions pour le faire.
Pour retranscrire en VBA tu peux enregistrer ta formule en macro, c'est un bon début pour apprendre
Bonne journée

 

[sylvanu]

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.