Créer une condition

Bonjour,

Pour mon boulot je dois créer un tableau excel.

Nous devons faire des permanences soit de 12h à 13h soit de 13h à 14h soit le soir de 17h30 à 18h.

Nous sommes 3 equipe.

En totalité nous devons effective 12 permanences de 12h à 13h et de 13h à 14h et 9 permanences de 17h30 à 18h.

Ce qui fait 4 personnes par equipe entre 12h et 14h et 3 entre 17h30 et 18h.

Mon probleme est le suivant par colones j'aimerais fixer une limite par equipe où si le nombre de volontaires est deja atteint, ceux qui s'incrivent après soit marquer d'une autre couleur automatiquement afin de pouvoir demander en cas de besoin au personnes inscrit en dernierde ce déplacer.

Vous trouverez un exemple du tableau excel avec les mises en forms conditionnelles.

12classeur1.xlsx (14.88 Ko)

Merci de votre retour.

Bonjour cece69720,

Je te propose ceci avec du code VBA:

  • On modifie l'extension du classeur pour ".xlsm" (pour pouvoir inclure des macros)
  • On ajoute une feuille "Paramètres" dans laquelle on stocke les plafonds de 12 et 9 astreintes.
  • On définit 4 plages nommées (>Formule>Gestionnaire de noms) pour repérer : la ligne portant les horaires, la ligne portant les totaux, le plafond1 et le plafond2 :
plagesnommees

- On ajoute le code suivant dans "Feuil1" :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Const cTextMIDI = "midi"
    Const cTextSOIR = "soir"

    Dim oCellTotal As Range, oCellHoraire As Range
    Dim lRowTotal As Long, lRowHoraires
    Dim lRowModif, lColModif
    Dim lPlafond As Long, lTotal As Long

    'On récupère l'adresse de la ligne d'horaires
    Set oCellHoraire = ThisWorkbook.Names("Ligne_Horaires").RefersToRange
    lRowHoraires = oCellHoraire.Row
    'On récupère l'adresse de la ligne Total
    Set oCellTotal = ThisWorkbook.Names("Total_par_créneaux").RefersToRange
    lRowTotal = oCellTotal.Row

    'On s'assure que la modification porte sur une seule cellule
    If Target.Rows.Count = 1 Or Target.Columns.Count = 1 Then
        'On s'assure que la cellule modifiée se trouve sur une ligne entre la ligne d'entête et la ligne de total
        If Target.Row > lRowHoraires And Target.Row < lRowTotal Then

            'On s'assure du texte indiqué dans la cellule modifié
            If LCase(Target.Value) = cTextMIDI Or LCase(Target.Value) = cTextSOIR Then
                lRowModif = Target.Row
                lColModif = Target.Column
                'On récupère la cellule d'horaire correspondante
                Set oCellHoraire = ActiveSheet.Cells(lRowHoraires, lColModif)

                'On récupère le plafond en fonction de l'horaire
                If InStr(1, oCellHoraire.Value, "12") > 0 Or InStr(1, oCellHoraire.Value, "13") > 0 Then
                    lPlafond = ThisWorkbook.Names("Plafond1").RefersToRange.Value
                ElseIf InStr(1, oCellHoraire.Value, "17") > 0 Then
                    lPlafond = ThisWorkbook.Names("Plafond2").RefersToRange.Value
                Else
                    lPlafond = 0
                End If

                'Si le plafond est affecté on teste le dépassement de plafond
                If lPlafond > 0 Then
                    'On récupère la valeur de la cellule de total correspondante
                    Set oCellTotal = ActiveSheet.Cells(lRowTotal, lColModif)
                    lTotal = oCellTotal.Value

                    'Si le total dépasse le plafond, on met le texte en rouge
                    If lTotal > lPlafond Then
                        Target.Font.Color = vbRed
                    End If
                End If
            End If
        End If
    End If
End Sub

Je joins mon classeur de test.

17classeur1-gvs.xlsm (25.36 Ko)

Bonjour,

Je vous remercie pour la réponse.

Je m'excuse je me suis mal exprimé.

La limite que je veux fixer est par équipe et non pas en totalité, c'est à dire que la limite étant de 4 entre 12h et 13h puis 13h et 14h par exemple, lorsque la limite de 4 dans une équipe est atteinte le inscription midi apparaît en une autre couleur.

Cordialement

Cedric

Bonjour Cédric,

En ce cas, je te propose :

-De créer des regroupements de chaque équipe sur la ligne "Manager" correspondant et le code suivant :

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Const cTextMIDI = "midi"
    Const cTextSOIR = "soir"

    Dim oCellTotal As Range, oCellHoraire As Range, oRow As Range
    Dim lRowTotal As Long, lRowHoraires
    Dim lRowModif, lColModif
    Dim lPlafond As Long, lTotal As Long

    'On récupère l'adresse de la ligne d'horaires
    Set oCellHoraire = ThisWorkbook.Names("Ligne_Horaires").RefersToRange
    lRowHoraires = oCellHoraire.Row
    'On récupère l'adresse de la ligne Total
    Set oCellTotal = ThisWorkbook.Names("Total_par_créneaux").RefersToRange
    lRowTotal = oCellTotal.Row

    'On s'assure que la modification porte sur une seule cellule
    If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
        'On s'assure que la cellule modifiée se trouve sur une ligne entre la ligne d'entête et la ligne de total
        If Target.Row > lRowHoraires And Target.Row < lRowTotal Then

            'On s'assure du texte indiqué dans la cellule modifié
            If LCase(Target.Value) = cTextMIDI Or LCase(Target.Value) = cTextSOIR Then
                lRowModif = Target.Row
                lColModif = Target.Column
                'On récupère la cellule d'horaire correspondante
                Set oCellHoraire = ActiveSheet.Cells(lRowHoraires, lColModif)

                'On récupère le plafond en fonction de l'horaire
                If InStr(1, oCellHoraire.Value, "12") > 0 Or InStr(1, oCellHoraire.Value, "13") > 0 Then
                    lPlafond = ThisWorkbook.Names("Plafond1").RefersToRange.Value
                ElseIf InStr(1, oCellHoraire.Value, "17") > 0 Then
                    lPlafond = ThisWorkbook.Names("Plafond2").RefersToRange.Value
                Else
                    lPlafond = 0
                End If

                'Si le plafond est affecté on teste le dépassement de plafond
                If lPlafond > 0 Then
                    'On récupère la valeur de la cellule de total manager correspondante
                    For Each oRow In ActiveSheet.Range(ActiveSheet.Cells(lRowModif, 1), ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count, 1))
                        If ActiveSheet.Rows(oRow.Row).OutlineLevel = 1 Then
                            Set oCellTotal = ActiveSheet.Cells(oRow.Row, lColModif)
                            lTotal = oCellTotal.Value
                            Exit For
                        End If
                    Next

                    'Si le total dépasse le plafond, on met le texte en rouge
                    If lTotal > lPlafond Then
                        Target.Font.Color = vbRed
                    Else
                        Target.Font.Color = vbBlack
                    End If
                End If
            Else
                Target.Font.Color = vbBlack
            End If
        End If
    End If
End Sub

Je joins la nouvelle version de mon classeur de test.

Bonjour,

Je vous remercie ça marche très bien.

Vous savez qu'il y a la possibilité de l'appliquer par zone parce que le nombre de personnes est répartie comme suis :

Lundi et Mardi :

12h à 13h = 4

13h à 14h = 4

17h30 à 18h = 3

Mercredi à Vendredi :

12h à 13h = 3

13h à 14h = 3

17h30 à 18h = 3

Merci de votre retour

Bonsoir Cédric,

Je te propose une 3ème version en P.J.

J'ai transformé la ligne d'entête de jour pour y introduire des dates à la place du texte ce qui permet de tester facilement le jour de la semaine avec le code ajouté suivant :

                lRowModif = Target.Row
                lColModif = Target.Column
                'On récupère la cellule d'horaire correspondante
                Set oCellHoraire = ActiveSheet.Cells(lRowHoraires, lColModif)

                'On récupère la cellule de date correspondante
                Set oCellDate = oCellHoraire.Offset(-1).MergeArea.Cells(1, 1)
                iJourSemaine = Weekday(oCellDate.Value, vbMonday) 'On récupère le jour de la semaine

                'On fixe le plafond en fonction de l'horaire et du jour de la semaine
                If iJourSemaine > 2 Then 'Si le jour de la semaine du mercredi au dimanche -> plafond = 3
                    lPlafond = ThisWorkbook.Names("Plafond2").RefersToRange.Value
                Else
                    'si l'horaire est entre 12h et 14h -> plafond = 4
                    If InStr(1, oCellHoraire.Value, "12") > 0 Or InStr(1, oCellHoraire.Value, "13") > 0 Then
                        lPlafond = ThisWorkbook.Names("Plafond1").RefersToRange.Value
                    'si l'horaire est 17h30 -> plafond = 3
                    ElseIf InStr(1, oCellHoraire.Value, "17") > 0 Then
                        lPlafond = ThisWorkbook.Names("Plafond2").RefersToRange.Value
                    Else
                        lPlafond = 0
                    End If
                End If
Rechercher des sujets similaires à "creer condition"