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

CISCO à dit:

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

Cliquez pour agrandir...

Aya_flo à dit:

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+

Cliquez pour agrandir...

piga25 à dit:

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.

VB:

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 :

Code:

        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é.

Cliquez pour agrandir...

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

piga25 à dit:

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.

VB:

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

Cliquez pour agrandir...

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