Repérer liste de valeurs identiques dans une colonne

Bonjour,

J’ai dans un tableau dans la colonne D les dates de l’année

Puis dans la colonne I les horaires d’une salariée

Je voudrais repérer les cellules de la colonne I qui contiennent la valeur « ca » et qui se suivent

Et je voudrais récupérer la date du début de la suite et la date de fin de la suite.

J’ai ce code

For j = 3 To Worksheets("2021 reel").Cells(Rows.Count, 4).End(xlUp).Row ‘tant qu’il y a une date

If Worksheets("2021 reel").Cells(j, 9) = "ca" And Worksheets("2021 reel").Cells(j - 1, 9) = "ca" Then 'repérer les ca qui se suivent

Range("a10").Value = Range("a10").Value & " " & Worksheets("2021 reel").Cells(j, 4) & " - " & Worksheets("2021 reel").Cells(j - 1, 4) 'récupérer la date de début et la date de fin de la suite

End If

Next

Mais le résultat est

17/08/2021 - 16/08/2021 18/08/2021 - 17/08/2021 19/08/2021 - 18/08/2021 20/08/2021 - 19/08/2021 31/08/2021 - 30/08/2021

Et je voudrais comme résultat

Du 16/08/2021 au 20/08/2021

Du 30/08/2021 au 31/08/2021

Pourriez vous m’aider svp ?

Je vous remercie beaucoup

Cordialement

Bonjour

Possible de voir votre fichier (sans données confidentielles) ce sera plus facile

Cordialement

Edit : peut être comme ceci..

Dim valeur1, valeur2
Dim j As Integer

With Worksheets("2021 reel")
    For j = 3 To .Cells(Rows.Count, 4).End(xlUp).Row
        If .Cells(j, 9) = "ca" And .Cells(j - 1, 9) = "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j + 1, 9) <> "ca" And .Cells(j - 1, 9) = "ca" Then valeur2 = .Cells(j, 4)
        If .Cells(j + 1, 9) <> "ca" Then
        .Range("A10") = .Range("A10") & "--" & valeur1 & " - " & valeur2
        valeur1 = 0
        valeur2 = 0
        End If
    Next j
End With

Le bouton de commande se trouve sur la feuille "conges"

les données recherchée se trouvent sur la feuille " 2021 reel"

J'ai testé votre code et j'ai des comme résultats, je vais regarder plus précisement

Je vous remercie de votre aide précieuse

Re

Heu votre fichier ne correspond pas à votre explication. Il n'y a pas de date

Cordialement

dans la colonne D de la feuille "2021 reel"

vous n'avez pas 2 feuilles dans le classeur?

Je l'ai ouvert et il y a bien 2 feuilles de mon côté

Cordialement

Re

Je ne parlais pas des feuilles mais des dates dans la feuille 2021. Mais pas de souci j'ai vu. Désolé...

essayez le code comme ceci

Private Sub CommandButton1_Click()
Dim valeur1, valeur2
Dim j As Integer

Range("A10").Clear
With Worksheets("2021 reel")
    For j = 3 To .Cells(Rows.Count, 4).End(xlUp).Row
        If .Cells(j, 9) = "ca" And .Cells(j - 1, 9) = "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j + 1, 9) <> "ca" And .Cells(j - 1, 9) = "ca" Then valeur2 = .Cells(j, 4)
        If .Cells(j + 1, 9) <> "ca" And valeur1 <> 0 Then
            If Range("A10") = "" Then
                Range("A10") = valeur1 & " - " & valeur2
            Else: Range("A10") = Range("A10") & " / " & valeur1 & " - " & valeur2
            End If
        valeur1 = 0
        valeur2 = 0
        End If
    Next j
End With
End Sub

Cordialement

Merci.

Je regarde demain et vous fait un retour

C'est parfait

Merci beaucoup

Bonjour

ok

J'ai mis à jour mon code avec le votre et ca fonctionne super bien, c'est top

Dernière question svp

est-ce possible de récupérer la date aussi quand il n'y a qu'une valeur "ca" qui ne se suit pas ?

Par exemple

- du 15/8 au 18/8 (comme votre code)

- du 20/8 au 25/8 (comme votre code)

- le 28/8

Je vous remercie

Bonjour

Essayez déjà comme ceci :

Private Sub CommandButton1_Click()
Dim valeur1, valeur2
Dim j As Integer
Dim liste
Range("A10").Clear
With Worksheets("2021 reel")
    For j = 3 To .Cells(Rows.Count, 4).End(xlUp).Row
        If .Cells(j, 9) = "ca" And .Cells(j - 1, 9) = "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j, 9) = "ca" And .Cells(j + 1, 9) <> "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j + 1, 9) <> "ca" And .Cells(j - 1, 9) = "ca" Then valeur2 = .Cells(j, 4)
        If .Cells(j + 1, 9) <> "ca" And valeur1 <> 0 Then
            If Range("A10") = "" Then
                Range("A10") = valeur1 & " - " & valeur2
            ElseIf valeur2 = 0 Then Range("A10") = Range("A10") & " / " & valeur1
            Else: Range("A10") = Range("A10") & " / " & valeur1 & " - " & valeur2
            End If
        valeur1 = 0
        valeur2 = 0
        End If
    Next j
End With
End Sub

Cordialement

Ca ne fonctionne pas

J'avais testé ca que le 31/08 et le resultat pour cette date est 30/08-26/08 (dans le sens inverse des autres plages de dates) ?

Re

Je n'avais pas testé à cet endroit. essayez comme ceci

Private Sub CommandButton1_Click()
Dim valeur1, valeur2
Dim j As Integer
Dim liste
Range("A10").Clear
With Worksheets("2021 reel")
    For j = 3 To .Cells(Rows.Count, 4).End(xlUp).Row
        If .Cells(j, 9) = "ca" And .Cells(j - 1, 9) = "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j, 9) = "ca" And .Cells(j + 1, 9) <> "ca" And valeur1 = 0 Then valeur1 = .Cells(j, 4) 'modifié
        If .Cells(j + 1, 9) <> "ca" And .Cells(j - 1, 9) = "ca" And valeur1 > 0 Then valeur2 = .Cells(j, 4)
        If .Cells(j + 1, 9) <> "ca" And valeur1 <> 0 Then
            If Range("A10") = "" Then
                Range("A10") = valeur1 & " - " & valeur2
            ElseIf valeur2 = 0 Then Range("A10") = Range("A10") & " / " & valeur1
            Else: Range("A10") = Range("A10") & " / " & valeur1 & " - " & valeur2
            End If
        valeur1 = 0
        valeur2 = 0
        End If
    Next j
End With
End Sub

C'es presque bon, le résultat est 30/08 mais ca devrait être 31/08 ?

Merci

J'ai modifié le code dans mon message précédent au j'avais laissé --> (j -1, 4)

Changez la ligne où j'ai mis "modifié" à la fin

Je n'avais pas vu votre dernier message, désolé.

Ca marche parfaitement, je vous remercie beaucoup, trop content

J'arrête de vous embêter et je vous souhaite un bon weekend et je n'oublie pas de cocher vos messages qui m'ont tant aidé

Cordialement

J'ai modifié le code pour ne pas avoir de tiret après la date quand ce n'est qu'un seul jour

Ca semble fonctionner

vous pouvez me confirmer ?

Et je vous laisse tranquille

Private Sub CommandButton1_Click()
Dim valeur1, valeur2
Dim j As Integer
Dim liste
Range("A10").Clear
With Worksheets("2021 reel")
    For j = 3 To .Cells(Rows.Count, 4).End(xlUp).Row
        If .Cells(j, 9) = "ca" And .Cells(j - 1, 9) = "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j, 9) = "ca" And .Cells(j + 1, 9) <> "ca" And valeur1 = 0 Then valeur1 = .Cells(j - 1, 4)
        If .Cells(j + 1, 9) <> "ca" And .Cells(j - 1, 9) = "ca" Then valeur2 = .Cells(j, 4)
        If .Cells(j + 1, 9) <> "ca" And valeur1 <> 0 Then
            If Range("A10") = "" And valeur2 = 0 Then
                Range("A10") = valeur1
            ElseIf Range("A10") = "" Then Range("A10") = valeur1 & " - " & valeur2
            ElseIf valeur2 = 0 Then Range("A10") = Range("A10") & " / " & valeur1
            Else: Range("A10") = Range("A10") & " / " & valeur1 & " - " & valeur2
            End If
        valeur1 = 0
        valeur2 = 0
        End If
    Next j
End With
End Sub

Oui cela fonctionne pas de soucis

Dommage pour tous les IF, on aurait pu probablement simplifier pour une meilleure lisibilité mais cela fonctionne c'est le principal

Cordialement