Congés; VBA

Résolu
Bonsoir chers tous

je reviens vers vous à nouveau pour solliciter votre aide

je voudrais attribuer des congés annuels ( "Ca") aux agents sur le planning de travail.
Pour ne pas me perdre en explications je vous joins le fichier pour un meilleur éclairage.

http://www.cjoint.com/c/FBew4Pan8oA

Merci de votre aide

22 réponses

  • Votes
  • Date
  • Date décroissante
  1. Bonsoir
    Voilà qui devrait aller
    Sub AdressesCA()
        Application.ScreenUpdating = False
        Dim com As Range
        Dim arr As Range
        Dim TotalCa
        
        DerLig = [E10000].End(xlUp).Row
        Sheets("feuil1").Range("$I$4:$FD$4", "$I$6:$FD$6").ClearContents
        For LigAct = 10 To DerLig
            Cells(LigAct, 5).Select
            Agent = Cells(LigAct, 5)
            PremCol = Cells(LigAct, 8).End(xlToRight).Column
            DerCol = Cells(LigAct, 2000).End(xlToLeft).Column
            TotalCa = 0
            If DerCol < 8 Then GoTo Suivant
            ReDim deb(DerCol) As String
            ReDim fin(DerCol) As String
            For i = PremCol To DerCol
                If Cells(LigAct, i - 1) <> "Ca" And Cells(LigAct, i) = "Ca" Then
                    deb(i) = Cells(LigAct, i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Cpt = 1
                    Do While Cells(LigAct, Cpt + i) = "Ca"
                        Cpt = Cpt + 1
                    Loop
                    fin(i) = Cells(LigAct, Cpt + i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Set celluletrouvee_DEB = Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)
                    Set celluletrouvee_FIN = Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0).Offset(0, -1)
                    fériés_1 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M2").Value)
                    fériés_2 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M3").Value)
                    fériés_3 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M4").Value)
                    fériés_4 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M5").Value)
                    fériés_5 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M6").Value)
                    fériés_6 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M7").Value)
                    fériés_7 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M8").Value)
                    fériés_8 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M9").Value)
                    fériés_9 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M10").Value)
                    fériés_10 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M11").Value)
                    fériés_11 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M12").Value)
                    fériés_12 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M13").Value)
                     
                    Total_féries = fériés_1 + fériés_2 + fériés_3 + fériés_4 + fériés_5 + fériés_6 + fériés_7 + fériés_8 + fériés_9 + fériés_10 + fériés_11 + fériés_12
                    TotalCa = TotalCa + Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Left((Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)) / 7, 1) - Total_féries
                    Sheets("feuil1").Range("F5").Value = WorksheetFunction.Sum(por)
                End If
            Next i
            Cells(LigAct, "FF").FormulaR1C1 = TotalCa
    Suivant:
        Next LigAct
    End Sub
    

    Cdlt
    1. Tout simplement magnifique , Vous etes le meilleur mon cher frenchies
      Désolée de n'avoir pas été assez claire au début

      Derniére chose ( j'abuse) ;
      Au lieu de passer par LigAct( cellule de l'agent sélectionnée) pourrais je avoir une procédure qui me calcule tout d'un coup sans sélectionner l'agent ?

      merci de votre aide précieuse
      1. Bonjour
        Voilà
        Sub AdressesCA()
            Application.ScreenUpdating = False
            If ActiveCell.Row < 10 Or ActiveCell.Column < 4 Then Exit Sub
            Dim com As Range
            Dim arr As Range
            Dim TotalCa
            Sheets("feuil1").Range("$I$4:$FD$4", "$I$6:$FD$6").ClearContents
            agent = Cells(ActiveCell.Row, 5)
            LigAct = ActiveCell.Row
            PremCol = Cells(LigAct, 8).End(xlToRight).Column
            DerCol = Cells(LigAct, 2000).End(xlToLeft).Column
            TotalCa = 0
            If DerCol < 8 Then
                MsgBox "Il n'y a pas de congé sur cet agent:  " & agent
                Exit Sub
            End If
            ReDim deb(DerCol) As String
            ReDim fin(DerCol) As String
            
            For i = PremCol To DerCol
                If Cells(LigAct, i - 1) <> "Ca" And Cells(LigAct, i) = "Ca" Then
                    deb(i) = Cells(LigAct, i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Cpt = 1
                    Do While Cells(LigAct, Cpt + i) = "Ca"
                        Cpt = Cpt + 1
                    Loop
                    fin(i) = Cells(LigAct, Cpt + i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    Set celluletrouvee_DEB = Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)
                    Set celluletrouvee_FIN = Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0).Offset(0, -1)
                    fériés_1 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M2").Value)
                    fériés_2 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M3").Value)
                    fériés_3 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M4").Value)
                    fériés_4 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M5").Value)
                    fériés_5 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M6").Value)
                    fériés_6 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M7").Value)
                    fériés_7 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M8").Value)
                    fériés_8 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M9").Value)
                    fériés_9 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M10").Value)
                    fériés_10 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M11").Value)
                    fériés_11 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M12").Value)
                    fériés_12 = Application.WorksheetFunction.CountIf(ActiveSheet.Range(celluletrouvee_DEB.Address, celluletrouvee_FIN.Address), Sheets("Donnees").Range("M13").Value)
                    Total_féries = fériés_1 + fériés_2 + fériés_3 + fériés_4 + fériés_5 + fériés_6 + fériés_7 + fériés_8 + fériés_9 + fériés_10 + fériés_11 + fériés_12
                    TotalCa = TotalCa + Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Left((Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)) / 7, 1) - Total_féries
                    Sheets("feuil1").Range("F5").Value = WorksheetFunction.Sum(por)
                End If
            Next i
            Cells(LigAct, "FF").FormulaR1C1 = TotalCa
        End Sub
        

        Cdlt
        1. Merci beaucoup Frenchies

          mes calculs ont corrects car je retire , le repos hebdomadaire dans chaque série de 8 jours de CA consécutifs et je retire aussi les jours fériés qui sont inclus dans les périodes de CA.
          De ce fait par exemple pour l'agent1 les CA affichés sur le planning sont au nbre de 13 mais en réalité son compteur de CA =12.

          Voilà pourquoi j'insistais sur l'utilisation de la macro pour le décompte des Ca.
          Bien à vous
          1. Effectivement même dans la correction je me suis planté.
            Cette fois c'est la bonne (enfin j'espère)
            Cells(LigAct, "FF").FormulaR1C1 = "=COUNTIF(R" & LigAct & "C9:R" & LigAct & "C160" & ",""Ca"")"

            Par contre, vos résultats sont faux,
            l'agent 1 compte 12 CA, j'en trouve 13
            l'agent 2 compte 31 CA, j'en trouve 36
            l'agent 3 compte 22 CA, j'en trouve 24
            l'agent 4 compte 18 CA, j'en trouve 20
            l'agent 5 compte 28 CA, j'en trouve 36
            l'agent 6 compte 7 CA, j'en trouve 9
            Cdlt
            1. Merci de votre persévérance
              Donc si vous observez le fichier , dans la cellule F4 s'affiche toujours le total des CA de l'agent sélectionné,; ce total n'est pas le décompte brute des CA marqués sur le planning, ce total est le fruit du calcul de la macro (adresse)

              Donc ce que je voudrais
              1- c'est de ne plus afficher les décompte de ca sur la ligne 4
              2- de mettre la valeur de F4 dans chaque cellule de la colonne FF correspondant à l'agent.

              ex pour l'agent 1 je décompte 12 CA (résultat F4) donc je devrais avoir 12 dans FF10
              pour l'agent 2 je décompte 31 CA (résultat F4) donc je devrais avoir 31 dans FF11

              etc....
              Avec votre code je trouve
              pour l'agent 1: 135ca
              pour l'agent 2 : 122 ca

              Merci encore pour votre dévouement
              1. Oui, j'ai bien compris ce que vous demandiez, j'avais fait une erreur de saisie dans mon code VBA, voici la bonne écriture
                   DerLig = [E1000].End(xlUp).Row
                    Range(Cells(10, "FF"), Cells(DerLig, "FF")).FormulaR1C1 = "=COUNTIF(RC10:R" & DerLig & "C160" & ",""Ca"")"

                Cdlt
                1. En fait j'ai ce code qui me permet d'avoir les nbres de jours de Ca sur la ligne 4

                  Cells(4, i) = Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Left((Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)) / 7, 1) - Total_féries

                  Ce que je voudrais c'est que le total des CA calculés s'affiche en bout de ligne correspondant a l'agent ( colonne FF) et ce sans que tout soit affiché sur la ligne 4

                  J'espére avoir été claire
                  Merci de votre aide
                  1. Je ne comprends pas, si vous collez les 2 lignes de code en fin de votre macro, cela ne répond-il pas à votre question?
                    Le total des CA de tous les agents est recalculé à chaque fois.
                    Si c'est la formule qui vous gêne, faîtes un "collage spécial - valeurs" pour n'en conserver que la valeur. A part ça, je ne vois pas ce qui ne colle pas. Ré-expliquez SVP.
                    Cdlt
                    1. Bonjour Frenchies

                      Merci de votre proposition mais elle ne répond pas à mon besoin.
                      En fait le calcul des CA ne se fait pas par le comptage des ca sur la ligne de l'agent mais en utilisant la macro qui est sur la feuille.

                      Cordialement
                      1. Bonjour
                        Par formule en FF10
                        =NB.SI(I10:FD10;"Ca")
                        à tirer vers le bas
                        ou en VBA
                            DerLig = [E1000].End(xlUp).Row
                            Range(Cells(10, "FF"), Cells(DerLig, "FF")).FormulaR1C1 = "=COUNTIF(RC10:RC" & DerLig & ",""Ca"")"


                        Cdlt
                        1. Bonjour a tous
                          Je voudrais afficher le total des CA sur la colonne FF et ligne correspondant à l'agent .
                          ex; agent 1 sur la cellule FF10
                          Agent 2 sur la cellule FF11
                          etc....

                          Merci de votre aide

                          http://www.cjoint.com/c/FCfr3ltjgSy
                          1. Bonjour
                            C'est magistral!!
                            Je suis sur la bonne voie avec votre travail:
                            Quelques réadaptations et tout sera au point
                            voilà ou j'en suis
                            Sub AdressesCA()
                            Application.ScreenUpdating = False
                            If ActiveCell.Row < 10 Or ActiveCell.Column < 4 Then Exit Sub
                            agent = Cells(ActiveCell.Row, 5)
                            LigAct = ActiveCell.Row

                            Dim com As Range
                            Dim arr As Range

                            PremCol = Cells(LigAct, 8).End(xlToRight).Column
                            DerCol = Cells(LigAct, 2000).End(xlToLeft).Column
                            If DerCol < 8 Then
                            MsgBox "Il n'y a pas de congé sur cet agent: " & agent
                            Exit Sub
                            End If
                            ReDim deb(DerCol) As String
                            ReDim fin(DerCol) As String

                            For i = PremCol To DerCol
                            If Cells(LigAct, i - 1) <> "Ca" And Cells(LigAct, i) = "Ca" Then
                            deb(i) = Cells(LigAct, i).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                            Cpt = 1

                            Do While Cells(LigAct, Cpt + i) = "Ca"
                            Cpt = Cpt + 1
                            Loop
                            fin(i) = Cells(LigAct, Cpt + i).Address(RowAbsolute:=False, ColumnAbsolute:=False)

                            Cells(6, i) = Cells(LigAct, Cpt + i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0) - Cells(LigAct, i).Offset(-(Cells(ActiveCell.Row, 5).Offset(0, -1) + 1), 0)

                            End If
                            Next i

                            End Sub


                            Vraiment merci

                            je reviens vers toi frenchie83 pour la suite

                            merci beaucoup
                            1. Bonjour à tous

                              En fait je cherche comment afficher dans un msgbox la date de début et la date de fin de chaque période de congés.

                              http://www.cjoint.com/c/FBkekQVlEtA
                              Merci de votre aide
                              1. Bonjour
                                je m'en suis beaucoup inspirée et je le garde sous le coude.

                                Toujours dans la meme lignée , pourriez vous m'apporter votre aide?

                                http://www.cjoint.com/c/FBkekQVlEtA

                                Cordialement
                                1. Bonjour
                                  ex: Agent 1 prend du 5/01/16 au 16/01/16 donc mathématiquement ça fait 11jours, Non 12 jours, donc 11 CA réels.

                                  Essayez ceci
                                  https://www.cjoint.com/c/FBhfHemRgaw
                                  Faites des tests sur le mois de mai, le plus intéressant.
                                  Le nombre de CA est en colonne C.
                                  En espérant que cela corresponde à vos attentes.
                                  Cdlt
                                  1. Bonjour à tous
                                    Merci pour vos propositions Frenchies et michel_m.
                                    J'ai pas mal avancé ( fière!!!= )
                                    Maintenant je me heurte à la problématique: du décompte des Congés annuels.
                                    En fait je voudrais que dans le décompte , pour chaque 8 jours pris successivement qu'il y ait un jour de retiré ( repos hebdomadaire)

                                    ex: Agent 1 prend du 5/01/16 au 16/01/16 donc mathématiquement ça fait 11jours, mais en calcul des Ca ça fera 10 jours car on a retiré un repos hebdomadaire: (c'est un service de soins ou les agents travaillent 8 j/8j) .

                                    ex2 : Si agent 2 prend du 20/1/16 au 9/02/16 ca fera 19 Ca au lieu de 21 Ca
                                    2 repos hebdomadaires retirés

                                    Par contre si le nombre de jour pris est inférieur à 8 donc
                                    nombre de Ca = Nombre de jours. Pas de repos hebdomadaire retiré.

                                    Donc comment détecter toutes les suites de 8 jours et retirer le nombre de suite.

                                    Du coup la même opération se pose en cas de jours fériés compris dans les Congés annuels.
                                    Il faudra retirer les jours fériés du décompte des Ca.

                                    Voilà mon gros problème
                                    Comment automatiser toutes ses conditions dans excel avec vba?
                                    merci de votre aide

                                    http://www.cjoint.com/c/FBgjKwrysqy
                                    1. Contributeur
                                      Bonjour,

                                      Et pour les jours fériés ?
                                  • 1
                                  • 2