Congés; VBA

Résolu

julia Namor Messages postés 524 Date d'inscription Statut Membre Dernière intervention -
julia Namor Messages postés 524 Date d'inscription Statut Membre Dernière intervention - 7 mars 2016 à 20:32

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

Afficher la suite

A voir également:

Congés; VBA
Planning congés - Guide
Excel compter cellule couleur sans vba - Guide
Incompatibilité de type vba ✓ - Forum VB / VBA
Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
Mkdir vba ✓ - Forum VB / VBA

22 réponses

Réponse 21 / 22

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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

Réponse 22 / 22

julia Namor Messages postés 524 Date d'inscription Statut Membre Dernière intervention 33

C'est tout bon
MERCI et MERCI encore

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

appliquer une pause dans une macro vba excel

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Votre réponse

Discussions similaires