Microsoft 365 Effacer Données Jours fériés

  • Initiateur de la discussion Initiateur de la discussion eric72
  • 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 !

eric72

XLDnaute Accro
Bonjour à tous,
Je me retrouve face à une égnime, je m'explique:
- J'ai un userform qui me permet de saisir des absences, par exemple TATA est en Congés payés du 23/12/2023 au 28/12/2023, j'aimerais qu'à la validation cela reporte dans mon tableau les jours ou TATA est en CP (ça j'y arrive), par contre j'aimerais que si il y a un jour férié, que cela reporte "Férié" au lieu de CP, et là je bloque.
Merci beaucoup pour votre aide (encore une fois).
Eric
 

Pièces jointes

Solution
Re le fil,
Après une petite modif, ça a l'air de rouler impecc

VB:
Sub Archive_Absence2()
'
Dim LigCible As Long, ColCible As Long, MaDateDebut As Long, MaDateFin As Long, lig, col, i

    'Application.ScreenUpdating = False

    MaDateDebut = CDate(UsfAjoutAbsence.TxtDebut)
    MaDateFin = CDate(UsfAjoutAbsence.TxtFin)

    With Sheets("Feuil1")

        Set lig = Application.Union(.Range("2:2"), .Range("8:8")).Find(UsfAjoutAbsence.CbNom, LookIn:=xlValues, lookat:=xlWhole)
        If lig Is Nothing Then Exit Sub
        LigCible = lig.Row

        Set col = Sheets("Feuil1").Range("1:1").Find(CDate(MaDateDebut), LookIn:=xlValues, lookat:=xlWhole)
        If col Is Nothing Then Exit Sub
        ColCible = col.Column...
Bonjour,

Une proposition :
VB:
Sub Archive_Absence2()
'
Dim LigCible As Long, ColCible As Long, MaDateDebut As Long, MaDateFin As Long, lig As Long, col As Long, i As Long

    Application.ScreenUpdating = False

    MaDateDebut = CDate(UsfAjoutAbsence.TxtDebut)
    MaDateFin = CDate(UsfAjoutAbsence.TxtFin)

    With Sheets("Feuil1")

        Set lig = Application.Union(.Range("2:2"), .Range("8:8")).Find(UsfAjoutAbsence.CbNom, LookIn:=xlValues, lookat:=xlWhole)
        If lig Is Nothing Then Exit Sub
        LigCible = lig.Row

        Set col = Sheets("Feuil1").Range("1:1").Find(CDate(MaDateDebut), LookIn:=xlValues, lookat:=xlWhole)     'UsfAjoutAbsence.TxtDebut
        If col Is Nothing Then Exit Sub
        ColCible = col.Column

        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Select
        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = UsfAjoutAbsence.TxtInit
        Sheets("Feuil1").Cells(LigCible + 2, ColCible).Resize(4, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = 0

        For i = MaDateDebut To MaDateFin
            If Not Range("t_Feries[Date]").Find(what:=CDate(i)) Is Nothing Then
                Sheets("Feuil1").Cells(LigCible + 1, ColCible + i - MaDateDebut).Value = "Férié"
            End If
        Next i

    End With

End Sub
 
Bonjour,

Une proposition :
VB:
Sub Archive_Absence2()
'
Dim LigCible As Long, ColCible As Long, MaDateDebut As Long, MaDateFin As Long, lig As Long, col As Long, i As Long

    Application.ScreenUpdating = False

    MaDateDebut = CDate(UsfAjoutAbsence.TxtDebut)
    MaDateFin = CDate(UsfAjoutAbsence.TxtFin)

    With Sheets("Feuil1")

        Set lig = Application.Union(.Range("2:2"), .Range("8:8")).Find(UsfAjoutAbsence.CbNom, LookIn:=xlValues, lookat:=xlWhole)
        If lig Is Nothing Then Exit Sub
        LigCible = lig.Row

        Set col = Sheets("Feuil1").Range("1:1").Find(CDate(MaDateDebut), LookIn:=xlValues, lookat:=xlWhole)     'UsfAjoutAbsence.TxtDebut
        If col Is Nothing Then Exit Sub
        ColCible = col.Column

        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Select
        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = UsfAjoutAbsence.TxtInit
        Sheets("Feuil1").Cells(LigCible + 2, ColCible).Resize(4, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = 0

        For i = MaDateDebut To MaDateFin
            If Not Range("t_Feries[Date]").Find(what:=CDate(i)) Is Nothing Then
                Sheets("Feuil1").Cells(LigCible + 1, ColCible + i - MaDateDebut).Value = "Férié"
            End If
        Next i

    End With

End Sub
Bonjour,
Ca faisait longtemps...
Ca beug sur Set lig "Objet requis"!!!
 
Re le fil,
Après une petite modif, ça a l'air de rouler impecc

VB:
Sub Archive_Absence2()
'
Dim LigCible As Long, ColCible As Long, MaDateDebut As Long, MaDateFin As Long, lig, col, i

    'Application.ScreenUpdating = False

    MaDateDebut = CDate(UsfAjoutAbsence.TxtDebut)
    MaDateFin = CDate(UsfAjoutAbsence.TxtFin)

    With Sheets("Feuil1")

        Set lig = Application.Union(.Range("2:2"), .Range("8:8")).Find(UsfAjoutAbsence.CbNom, LookIn:=xlValues, lookat:=xlWhole)
        If lig Is Nothing Then Exit Sub
        LigCible = lig.Row

        Set col = Sheets("Feuil1").Range("1:1").Find(CDate(MaDateDebut), LookIn:=xlValues, lookat:=xlWhole)
        If col Is Nothing Then Exit Sub
        ColCible = col.Column

        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Select
        Sheets("Feuil1").Cells(LigCible + 1, ColCible).Resize(1, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = UsfAjoutAbsence.TxtInit
        Sheets("Feuil1").Cells(LigCible + 2, ColCible).Resize(4, CDate(MaDateFin) - CDate(MaDateDebut) + 1).Value = 0

        For i = MaDateDebut To MaDateFin
            If Not Range("Ferie").Find(what:=CDate(i)) Is Nothing Then
                Sheets("Feuil1").Cells(LigCible + 1, ColCible + i - MaDateDebut).Value = "Férié"
            End If
        Next i

    End With
    End Sub

Merci beaucoup encore une fois à

TooFatBoy , fanfan38 et dysorthographie

pour votre aide toujours aussi précieuse.
Bonne journée
 
- 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
Retour