XL 2016 Compter des cellules dont les données sont consécutives

[oscarette]

Bonjour,
j'ai un tableau où je saisi les prévisionnels de congés payés (CP) pour la période du 01/06/2024 au 31/10/2024.
Je dois vérifier que cette pose de CP respecte les règles suivantes :
20 jours maximum doivent être pris sur la période du 01/06/2024 au 31/10/2024
Dont 10 jours minimum obligatoirement consécutifs
Les autres jours doivent se prendre par période de 5 jours consécutifs minimum
Le solde sera à prendre à partir du 01/11/2024. On ne s'occupe pas du solde dans ce tableau.

J'ai mis dans l'onglet "Mode d'emploi" tous les détails et explications pour une meilleure compréhension.
Je pensais identifier et compter le nombre de périodes consécutives afin de savoir si la personne a bien posé les 10 jours consécutifs obligatoires (règle n° 2) et faire de même pour les autres congés qui doivent être pris au minimum par 5 jours consécutifs (règle n° 3) tout en respectant la pose de 20 jours maximum sur cette période (Règle n° 1).
Le comptage des "paquets" de CP consécutifs n'est peut-être pas la bonne méthode pour savoir si les personnes ont posés leur CP dans le respect des règles je ne vois que cette méthode. Si vous imaginez d'autres méthodes, je suis ouverte à toutes propositions.

Ne sachant pas faire les formules pou compter les périodes consécutives, j'ai besoin de votre aide et de vos explications afin d'avancer de ce tableau.

Je vous remercie par avance pour votre aide.

 

[CISCO]

Bonsoir
Où en es-tu sur ce sujet ?
@ plus

 

[oscarette]

Bonsoir
Où en es-tu sur ce sujet ?
@ plus

Bonjour
Je n'ai pas eu de réponses et je n'ai pas plus avancé du coup.
En vous remerciant pour votre aide si cela est possible

 

[Aya_flo]

Bonjour,
Les cases à compter sont celles remplies avec L ?
Est ce envisageable de la faire avec une macro pour la gestion de la contrainte "consécutif"?

A+

 

[oscarette]

Bonjour,
Les cases à compter sont celles remplies avec L ?
Est ce envisageable de la faire avec une macro pour la gestion de la contrainte "consécutif"?

A+

Bonjour,
Oui tout à fait. Ce sont bien les cases "L" qui doivent respecter les 3 différentes règles.
Pour la macro, si l'on m'explique le sens et la macro qui sera faite, pourquoi ne pas tenter si cela simplifie les choses. J'ai déjà fait des macros dans le passé donc ce n'est pas une inconnue mais il faut que je puisse comprendre.

Ma question peut paraitre bête mais n'existe t'il pas de solution sans macro ? même si je ne suis pas contre l'idée d'une macro.

Merci beaucoup pour l'aide apportée.
Bonne journée

 

[piga25]

Bonjour,
J'ai essayé avec l'aide de ChatGPT de créer un code,
Le premier code, compte de nombre de séquences (uniquement sur la ligne 6)
Le second , compte le nombre de séquences et donne la séquence la plus longue (uniquement sur la ligne 7),
Pour le troisième rien de concluant en voulant inclure les weekends dans les séquences (pour la ligne 8).
Le quatrième il y a bug, n'arrive pas a prendre en compte la ligne des dates.

Sub CountConsecutiveL()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Congés") ' Remplacez "Feuille1" par le nom de votre feuille
    Dim startRow As Integer
    Dim endRow As Integer
    Dim outputColND As String
    Dim outputColNE As String
    Dim dateRange As Range
    Dim currentCell As Range
    Dim consecutiveCount As Integer
    Dim maxConsecutive As Integer
    Dim rowIndex As Integer
    startRow = 6
    endRow = 15
    outputColND = "ND"
    outputColNE = "NE"
    Set dateRange = ws.Range("GQ5:MM5")
    ' Clear previous results in ND and NE columns
    ws.Columns(outputColND).ClearContents
    ws.Columns(outputColNE).ClearContents
    ' Loop through each row in the range from GQ6 to MM15
    For rowIndex = startRow To endRow
        consecutiveCount = 0
        maxConsecutive = 0
        ' Loop through each cell in the current row
        For Each currentCell In ws.Range(ws.Cells(rowIndex, dateRange.Columns(1).Column), ws.Cells(rowIndex, dateRange.Columns.Count + dateRange.Columns(1).Column - 1))
            ' Check if the current cell is a weekend (Saturday or Sunday)
            If Weekday(currentCell.Value, vbMonday) >= 6 Then
                ' If it's a weekend, reset the consecutive count
                consecutiveCount = 0
            ElseIf currentCell.Value = "L" Then
                ' If it's not a weekend and it's "L", increment the consecutive count
                consecutiveCount = consecutiveCount + 1
                ' Update maxConsecutive if necessary
                If consecutiveCount > maxConsecutive Then
                    maxConsecutive = consecutiveCount
                End If
            Else
                ' If it's not "L", reset the consecutive count
                consecutiveCount = 0
            End If
        Next currentCell
        ' Output the results for the current row
        ws.Cells(rowIndex, outputColND).Value = consecutiveCount
        ws.Cells(rowIndex, outputColNE).Value = maxConsecutive
    Next rowIndex
End Sub

Bug sur ces lignes :

        For Each currentCell In ws.Range(ws.Cells(rowIndex, dateRange.Columns(1).Column), ws.Cells(rowIndex, dateRange.Columns.Count + dateRange.Columns(1).Column - 1))
            ' Check if the current cell is a weekend (Saturday or Sunday)
            If Weekday(currentCell.Value, vbMonday) >= 6 Then

Néanmoins cela permettra peut être d'avoir une idée sur la faisabilité.

 

[oscarette]

Bonjour,
J'ai essayé avec l'aide de ChatGPT de créer un code,
Le premier code, compte de nombre de séquences (uniquement sur la ligne 6)
Le second , compte le nombre de séquences et donne la séquence la plus longue (uniquement sur la ligne 7),
Pour le troisième rien de concluant en voulant inclure les weekends dans les séquences (pour la ligne 8).
Le quatrième il y a bug, n'arrive pas a prendre en compte la ligne des dates.

Sub CountConsecutiveL()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Congés") ' Remplacez "Feuille1" par le nom de votre feuille
    Dim startRow As Integer
    Dim endRow As Integer
    Dim outputColND As String
    Dim outputColNE As String
    Dim dateRange As Range
    Dim currentCell As Range
    Dim consecutiveCount As Integer
    Dim maxConsecutive As Integer
    Dim rowIndex As Integer
    startRow = 6
    endRow = 15
    outputColND = "ND"
    outputColNE = "NE"
    Set dateRange = ws.Range("GQ5:MM5")
    ' Clear previous results in ND and NE columns
    ws.Columns(outputColND).ClearContents
    ws.Columns(outputColNE).ClearContents
    ' Loop through each row in the range from GQ6 to MM15
    For rowIndex = startRow To endRow
        consecutiveCount = 0
        maxConsecutive = 0
        ' Loop through each cell in the current row
        For Each currentCell In ws.Range(ws.Cells(rowIndex, dateRange.Columns(1).Column), ws.Cells(rowIndex, dateRange.Columns.Count + dateRange.Columns(1).Column - 1))
            ' Check if the current cell is a weekend (Saturday or Sunday)
            If Weekday(currentCell.Value, vbMonday) >= 6 Then
                ' If it's a weekend, reset the consecutive count
                consecutiveCount = 0
            ElseIf currentCell.Value = "L" Then
                ' If it's not a weekend and it's "L", increment the consecutive count
                consecutiveCount = consecutiveCount + 1
                ' Update maxConsecutive if necessary
                If consecutiveCount > maxConsecutive Then
                    maxConsecutive = consecutiveCount
                End If
            Else
                ' If it's not "L", reset the consecutive count
                consecutiveCount = 0
            End If
        Next currentCell
        ' Output the results for the current row
        ws.Cells(rowIndex, outputColND).Value = consecutiveCount
        ws.Cells(rowIndex, outputColNE).Value = maxConsecutive
    Next rowIndex
End Sub

Bug sur ces lignes :

        For Each currentCell In ws.Range(ws.Cells(rowIndex, dateRange.Columns(1).Column), ws.Cells(rowIndex, dateRange.Columns.Count + dateRange.Columns(1).Column - 1))
            ' Check if the current cell is a weekend (Saturday or Sunday)
            If Weekday(currentCell.Value, vbMonday) >= 6 Then

Néanmoins cela permettra peut être d'avoir une idée sur la faisabilité.

Bonjour
Et merci beaucoup pour ce travail mais en effet cela ne correspond pas car il faut que les WE soient inclus.
Mais une petite question bête à laquelle je ne sais pas répondre. Dans EXCEL, sans passez par une macro, il doit bien y avoir une formule pour connaitre le nombre de cellules qui sont consécutiives ?

Pas d'idées sur ce point ?
Merci d'avance

 

[piga25]

Bonjour,
Voir avec cela mais en marquant les weekends compris dans les congés avec un "L"

Explications :​

1. Définir la feuille de calcul :
   • Le fichier Excel est chargé et la feuille de calcul spécifiée est sélectionnée.
2. Définir les coordonnées de la plage à parcourir :
   • Les colonnes de début et de fin (GQ et MM) ainsi que les lignes de début et de fin (6 à 15) sont définies.
3. Définir la colonne de destination :
   • destinationCol est la colonne où les résultats seront écrits (à partir de NI).
4. Boucle à travers chaque ligne et chaque cellule :
   • Pour chaque ligne, le code initialise les compteurs pour les séquences de "L" consécutives.
   • Pour chaque cellule de la ligne, on vérifie la valeur et la date correspondante.
   • Si la date correspond à un week-end (samedi ou dimanche), la cellule est ignorée.
5. Stockage et tri des séquences :
   • Les séquences de "L" consécutives sont stockées dans une collection.
   • Une fois toutes les séquences trouvées, elles sont triées par ordre décroissant en utilisant un tri à bulles (fonction BubbleSort).
6. Écrire les résultats :
   • Les séquences triées sont écrites dans les colonnes à partir de NI pour chaque ligne concernée. Les colonnes suivantes (NJ, NK, NL, etc.) recevront les séquences suivantes.

Sub CountConsecutiveL()
    Dim ws As Worksheet
    Dim startCol As String
    Dim endCol As String
    Dim startRow As Long
    Dim endRow As Long
    Dim destinationCol As String
    Dim currentRow As Long
    Dim currentCol As Long
    Dim cellValue As String
    Dim consecutiveL As Long
    Dim sequences As Collection
    Dim seq As Variant
    Dim colOffset As Long
    Dim dateCell As Range
    Dim dateValue As Variant

    ' Définir la feuille de calcul
    Set ws = ThisWorkbook.Sheets("Congés") ' Remplacez par le nom de votre feuille de calcul

    ' Définir les coordonnées de la plage à parcourir
    startCol = "GQ"
    endCol = "MM"
    startRow = 6
    endRow = 15

    ' Définir la colonne de destination initiale
    destinationCol = "NI"
    colOffset = 0

    ' Boucler à travers chaque ligne de la plage
    For currentRow = startRow To endRow
        consecutiveL = 0
        Set sequences = New Collection

        ' Boucler à travers chaque cellule de la ligne
        For currentCol = ws.Range(startCol & startRow).Column To ws.Range(endCol & startRow).Column
            cellValue = ws.Cells(currentRow, currentCol).Value
            Set dateCell = ws.Cells(5, currentCol) ' La ligne des dates est fixée à la ligne 5
            dateValue = dateCell.Value

            ' Vérifier si la date est un week-end (samedi ou dimanche)
            If Weekday(dateValue, vbMonday) <> 6 And Weekday(dateValue, vbMonday) <> 7 Then
                If cellValue = "L" Then
                    consecutiveL = consecutiveL + 1
                Else
                    If consecutiveL > 0 Then
                        sequences.Add consecutiveL
                    End If
                    consecutiveL = 0
                End If
            End If
        Next currentCol

        ' Ajouter la dernière séquence si la ligne se termine par "L"
        If consecutiveL > 0 Then
            sequences.Add consecutiveL
        End If

        ' Trier les séquences par ordre décroissant
        Dim sortedSequences() As Long
        ReDim sortedSequences(1 To sequences.Count)
        Dim i As Long
        For i = 1 To sequences.Count
            sortedSequences(i) = sequences(i)
        Next i
        Call BubbleSort(sortedSequences)

        ' Écrire les séquences dans les colonnes de destination
        colOffset = 0
        For i = 1 To UBound(sortedSequences)
            ws.Cells(currentRow, ws.Range(destinationCol & startRow).Column + colOffset).Value = sortedSequences(i)
            colOffset = colOffset + 1
        Next i
    Next currentRow
End Sub

Sub BubbleSort(arr() As Long)
    Dim i As Long, j As Long, temp As Long
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) < arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

 

[oscarette]

Bonjour,
Voir avec cela mais en marquant les weekends compris dans les congés avec un "L"

Explications :​

1. Définir la feuille de calcul:
   • Le fichier Excel est chargé et la feuille de calcul spécifiée est sélectionnée.
2. Définir les coordonnées de la plage à parcourir:
   • Les colonnes de début et de fin (GQ et MM) ainsi que les lignes de début et de fin (6 à 15) sont définies.
3. Définir la colonne de destination:
   • destinationCol est la colonne où les résultats seront écrits (à partir de NI).
4. Boucle à travers chaque ligne et chaque cellule:
   • Pour chaque ligne, le code initialise les compteurs pour les séquences de "L" consécutives.
   • Pour chaque cellule de la ligne, on vérifie la valeur et la date correspondante.
   • Si la date correspond à un week-end (samedi ou dimanche), la cellule est ignorée.
5. Stockage et tri des séquences:
   • Les séquences de "L" consécutives sont stockées dans une collection.
   • Une fois toutes les séquences trouvées, elles sont triées par ordre décroissant en utilisant un tri à bulles (fonction BubbleSort).
6. Écrire les résultats:
   • Les séquences triées sont écrites dans les colonnes à partir de NI pour chaque ligne concernée. Les colonnes suivantes (NJ, NK, NL, etc.) recevront les séquences suivantes.

Sub CountConsecutiveL()
    Dim ws As Worksheet
    Dim startCol As String
    Dim endCol As String
    Dim startRow As Long
    Dim endRow As Long
    Dim destinationCol As String
    Dim currentRow As Long
    Dim currentCol As Long
    Dim cellValue As String
    Dim consecutiveL As Long
    Dim sequences As Collection
    Dim seq As Variant
    Dim colOffset As Long
    Dim dateCell As Range
    Dim dateValue As Variant

    ' Définir la feuille de calcul
    Set ws = ThisWorkbook.Sheets("Congés") ' Remplacez par le nom de votre feuille de calcul

    ' Définir les coordonnées de la plage à parcourir
    startCol = "GQ"
    endCol = "MM"
    startRow = 6
    endRow = 15

    ' Définir la colonne de destination initiale
    destinationCol = "NI"
    colOffset = 0

    ' Boucler à travers chaque ligne de la plage
    For currentRow = startRow To endRow
        consecutiveL = 0
        Set sequences = New Collection

        ' Boucler à travers chaque cellule de la ligne
        For currentCol = ws.Range(startCol & startRow).Column To ws.Range(endCol & startRow).Column
            cellValue = ws.Cells(currentRow, currentCol).Value
            Set dateCell = ws.Cells(5, currentCol) ' La ligne des dates est fixée à la ligne 5
            dateValue = dateCell.Value

            ' Vérifier si la date est un week-end (samedi ou dimanche)
            If Weekday(dateValue, vbMonday) <> 6 And Weekday(dateValue, vbMonday) <> 7 Then
                If cellValue = "L" Then
                    consecutiveL = consecutiveL + 1
                Else
                    If consecutiveL > 0 Then
                        sequences.Add consecutiveL
                    End If
                    consecutiveL = 0
                End If
            End If
        Next currentCol

        ' Ajouter la dernière séquence si la ligne se termine par "L"
        If consecutiveL > 0 Then
            sequences.Add consecutiveL
        End If

        ' Trier les séquences par ordre décroissant
        Dim sortedSequences() As Long
        ReDim sortedSequences(1 To sequences.Count)
        Dim i As Long
        For i = 1 To sequences.Count
            sortedSequences(i) = sequences(i)
        Next i
        Call BubbleSort(sortedSequences)

        ' Écrire les séquences dans les colonnes de destination
        colOffset = 0
        For i = 1 To UBound(sortedSequences)
            ws.Cells(currentRow, ws.Range(destinationCol & startRow).Column + colOffset).Value = sortedSequences(i)
            colOffset = colOffset + 1
        Next i
    Next currentRow
End Sub

Sub BubbleSort(arr() As Long)
    Dim i As Long, j As Long, temp As Long
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) < arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

Bonsoir Piga 25,
Merci beaucoup pour toutes ces explications claires et détaillées qui me permettent de comprendre presque quasiment tout même si beaucoup de terme sont totalement inconnus pour moi. Le principal étant de comprendre !
Je vais me pencher sur votre travail plus en détail pour bien comprendre et voir si la macro permet les bons résultats pour toutes les règles.
J'ai déjà remarqué une erreur car pour la règle n° 1 (cellule NE4), ce ne sont pas 20 jours consécutifs mais 20 jours maximum comme indiqué dans mon fichier initial. Cette donnée change les résultats de la colonne NE.
Je regarde cela en fin de semaine car je dois m'absenter et je reviens vers vous si cela vous convient.
Merci beaucoup et bonne semaine

 

[piga25]

Bonjour,
Nouvelle version en conservant vos données tels que vous les avez entrées.

Ce code permet de comptabiliser les séquences de "L" en incluant les week-ends et les jours fériés dans le décompte mais les soustrayant avant d'écrire les résultats dans la colonne de destination.

Explications du code :​

1. Définir la feuille de calcul principale :
   • ws représente la feuille de calcul principale.
   • dataWs représente la feuille de calcul contenant les jours fériés.
2. Définir les coordonnées de la plage :
   • startCol et endCol définissent les colonnes de début et de fin.
   • startRow et endRow définissent les lignes de début et de fin.
   • destinationCol définit la colonne de destination pour les résultats.
3. Charger les jours fériés dans une collection :
   • Les jours fériés sont chargés dans une collection pour une vérification rapide.
4. Boucle à travers chaque ligne et chaque cellule :
   • Pour chaque ligne, une collection de séquences de "L" est initialisée.
   • weekendHolidayCount est utilisé pour compter les week-ends et jours fériés dans chaque séquence.
   • Pour chaque cellule, la valeur et la date correspondante sont vérifiées.
   • Les cellules correspondant à un week-end ou à un jour férié sont incluses dans la séquence en cours si une séquence est active et comptées dans weekendHolidayCount.
5. Fonction IsHoliday :
   • La fonction IsHoliday vérifie si une date donnée est un jour férié ou un pont en la comparant avec les jours fériés stockés dans la collection.
6. Transférer les séquences dans un tableau et trier :
   • Les séquences de "L" sont transférées dans un tableau.
   • Le tableau est trié en ordre décroissant en utilisant un tri à bulles.
7. Écrire les résultats :
   • Les séquences triées, moins les week-ends et jours fériés, sont écrites dans les colonnes à partir de NP pour chaque ligne concernée.

Sub ProcessSequences()
    Dim ws As Worksheet
    Dim dataWs As Worksheet
    Dim startCol As Long, endCol As Long
    Dim startRow As Long, endRow As Long
    Dim destinationCol As Long
    Dim currentRow As Long, currentCol As Long
    Dim sequenceCount As Long
    Dim sequenceCollection As Collection
    Dim holidays As Collection
    Dim cellValue As String
    Dim cellDate As Date
    Dim i As Long, j As Long
    Dim temp As Long
    Dim sequences() As Long
   
    ' Définir la feuille de calcul principale
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Ajustez le nom de la feuille si nécessaire
    Set dataWs = ThisWorkbook.Sheets("Data")
   
    ' Définir les coordonnées de la plage
    startCol = ws.Range("GQ1").Column
    endCol = ws.Range("MM1").Column
    startRow = 6
    endRow = 15
    destinationCol = ws.Range("NP1").Column
   
    ' Charger les jours fériés dans une collection
    Set holidays = New Collection
    For i = 5 To 17
        On Error Resume Next
        holidays.Add dataWs.Cells(i, 2).Value, CStr(dataWs.Cells(i, 2).Value)
        On Error GoTo 0
    Next i
   
    ' Boucle à travers chaque ligne
    For currentRow = startRow To endRow
        Set sequenceCollection = New Collection
        sequenceCount = 0
        Dim weekendHolidayCount As Long
        weekendHolidayCount = 0
        Dim inSequence As Boolean
        inSequence = False
       
        ' Boucle à travers chaque cellule de la ligne
        For currentCol = startCol To endCol
            cellValue = ws.Cells(currentRow, currentCol).Value
            cellDate = ws.Cells(5, currentCol).Value ' Les dates sont en ligne 5
           
            ' Traiter la valeur de la cellule
            If cellValue = "L" Then
                sequenceCount = sequenceCount + 1
                inSequence = True
            ElseIf Weekday(cellDate, vbMonday) >= 6 Or IsHoliday(cellDate, holidays) Then
                ' Inclure les week-ends et jours fériés dans la séquence en cours
                If inSequence Then
                    sequenceCount = sequenceCount + 1
                    weekendHolidayCount = weekendHolidayCount + 1
                End If
            Else
                ' Fin de la séquence actuelle
                If sequenceCount > 0 Then
                    ' Soustraire les week-ends et jours fériés
                    sequenceCollection.Add sequenceCount - weekendHolidayCount
                    sequenceCount = 0
                    weekendHolidayCount = 0
                End If
                inSequence = False
            End If
        Next currentCol
       
        ' Ajouter toute séquence restante à la collection
        If sequenceCount > 0 Then
            sequenceCollection.Add sequenceCount - weekendHolidayCount
        End If
       
        ' Transférer les séquences dans un tableau pour le tri
        ReDim sequences(1 To sequenceCollection.Count)
        For i = 1 To sequenceCollection.Count
            sequences(i) = sequenceCollection(i)
        Next i
       
        ' Trier les séquences en utilisant le tri à bulles
        For i = 1 To UBound(sequences) - 1
            For j = 1 To UBound(sequences) - i
                If sequences(j) < sequences(j + 1) Then
                    temp = sequences(j)
                    sequences(j) = sequences(j + 1)
                    sequences(j + 1) = temp
                End If
            Next j
        Next i
       
        ' Écrire les séquences triées dans la colonne de destination
        For i = 1 To UBound(sequences)
            ws.Cells(currentRow, destinationCol + i - 1).Value = sequences(i)
        Next i
    Next currentRow
End Sub

Function IsHoliday(dateToCheck As Date, holidays As Collection) As Boolean
    Dim i As Long
    IsHoliday = False
    For i = 1 To holidays.Count
        If dateToCheck = holidays(i) Then
            IsHoliday = True
            Exit Function
        End If
    Next i
End Function