Mesurer la plus longue série de cellules contenant "X"

Bonjour, Bonsoir,

Ayant l'habitude de faire des Excels pour tout et pour rien, je pense me plaire parmi vous.

J'essaie de faire un un suivis de progression de différentes activités à faire quotidiennement au long de l'année avec des paliers pour récompense.
Dans cette version de mon fichier, je vous fait grâce des 53 semaines, dans un tableau chaque activité accomplie est cochée chaque jour. Un tableau affichant des paliers de 1 jour / 7 jours / 15 jours / [...] se coche automatiquement en fonction de la durée de la série la plus longue. Il ne s'agit pas d'additionner chaque jour où l'activité a été accomplie, mais bien d'identifier que x jours d'affilés on été accomplis. Si je coche 8 jours d'affilés en face de l'activité x, puis que je n'effectue pas l'activité en question le jour suivant, mon compte s'arrête et attend qu'une prochaine série le rattrape.

J'avais procédé une première fois en utilisant la formule suivant, vous la trouverez dans la colonne M :

=SI(NB.SI(B13:O13;"x")=0;0;SOMMEPROD((B13:O13="x")*(C13:P13="x")*1)+1)

Mais celui-ci ne marche pas parfaitement pour une raison qui m'échappe, comme vous pouvez le constater dans la cellule M5, la série est de 6 et non 8.
Serait-ce dû au décalage que j'utilise dans ma formule et/ou Auriez-vous une autre solution ?

Merci d'avance !

Toto

Bonjour et bienvenue sur le forum

Tu écris :

comme vous pouvez le constater dans la cellule M5

Et bien non, on ne peut rien constater car tu n'as pas joint de fichier !

Bye !

Bonjour GMB,

Mea Culpa, il me semblait l'avoir fait !

Voici le fichier, haha

Un essai à tester. Te convient-il ?

Option Explicit

Dim tablo
Dim i&, j&, cum&, cumM&

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range(Cells(14, 2), Cells(Range("A" & Rows.Count).End(xlUp).Row, _
            Cells(12, Columns.Count).End(xlToLeft).Column))) Is Nothing Then
        Application.EnableEvents = False
        tablo = Range(Cells(13, 2), Cells(Range("A" & Rows.Count).End(xlUp).Row, _
            Cells(12, Columns.Count).End(xlToLeft).Column))
        For i = 1 To UBound(tablo, 1)
            cum = 0: cumM = 0
            For j = 1 To UBound(tablo, 2)
                If UCase(tablo(i, j)) = "X" Then
                    cum = cum + 1
                    If cum > cumM Then
                        cumM = cum
                    End If
                ElseIf tablo(i, j) = "" Then
                    cum = 0
                End If
            Next j
            Range("M" & i + 1) = cumM
        Next i
    End If
    Application.EnableEvents = True
End Sub

Bye !

Tout d'abord, je te remercie pour ta réponse GMK !

Ensuite, je n'utilise que rarement la VBA, le moins possible pour être honnête car je n'ai pas trop le temps d'approfondir cette compétence.
Cependant je me suis permis de corriger la ligne suivante :

   If Not Intersect(Target, Range(Cells(14, 2), Cells(Range("A" & Rows.Count).End(xlUp).Row, _  'ici ce devrait être Cells(13, 2)

La valeur de la plus longue série de l'activité 1 ne semblait pas se mettre à jour lorsque qu'une croix y était ajoutée jusqu'à ce qu'une autre ligne soit modifiée.

J'attends un commentaire confirmant que je n'ai pas fait de bêtise et je clos mon sujet !

EDIT : Ah .. Aussi, et c'est l'une des raisons pour lesquelles je suis nul en VBA, c'est que dans ma version originale, le tableau dans lequel faire les croix se trouve dans une autre page que celle reportant les paliers. Je n'arrive pas à adapter ton code pour range l'autre feuille. J'ai essayé avec :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Worksheets("Suivi").Range(Cells(3, 2), Cells(Worksheets("Suivi").Range("A" & Rows.Count).End(xlUp).Row, _     'mon tableau de croix étant dans une feuille dédiée se nommant "Suivi", la première croix possible est à cette adresse
            Cells(2, Columns.Count).End(xlToLeft).Column))) Is Nothing Then
        Application.EnableEvents = False
        tablo = Worksheets("Suivi").Range(Cells(3, 2), Cells(Worksheets("Suivi").Range("A" & Rows.Count).End(xlUp).Row, _   'même commentaire
            Cells(2, Columns.Count).End(xlToLeft).Column))
        For i = 1 To UBound(tablo, 1)
            cum = 0: cumM = 0
            For j = 1 To UBound(tablo, 2)
                If UCase(tablo(i, j)) = "X" Then
                    cum = cum + 1
                    If cum > cumM Then
                        cumM = cum
                    End If
                ElseIf tablo(i, j) = "" Then
                    cum = 0
                End If
            Next j
            Range("M" & i + 1) = cumM    'j'ai gardé la même colonne que la version allégée
        Next i
    End If
    Application.EnableEvents = True
End Sub

Bonjour à toutes et tous, TotoEtTiti, gmb,

Hier j'ai cherché une solution par formule, puis j'ai abandonné en voyant la solution très efficace de @gmb.

Aujourd'hui je vois ton commentaire "Ensuite, je n'utilise que rarement la VBA, le moins possible pour être honnête car je n'ai pas trop le temps d'approfondir cette compétence."

A tester cette proposition par formule à adapter à ton fichier puisque tu sembles vouloir le résultat dans une autre feuille.

J'explique en 2 mots, pas moyen de faire autrement que de rajouter des lignes au niveau du tableau semainier. Donc à voir si tu as la possibilité de le faire.

Bien sûr, tu peux ensuite masquer les lignes ajoutées pour les calculs.

Cordialement.

Bonjour mdo100,

Il est vrai que plutôt de m'entêter à vouloir faire une formule all in one, j'aurais pu segmenter la démarche.
Ton idée fonctionne donc j'accepte la solution, mais je reste tout de même curieux à propos du code de gmb.

Un meilleur exemple de fichier ci-joint. :)

Je te remercie !

Bonjour à tous

Nouvelle version.

Bye !

Bonjour Gmb,

Ce que tu as fait est semble-t-il .. excellent.
A première vue, ton code avait l'air plus simple que le précédent, donc j'ai essayé de le comprendre. Je n'y suis pas arrivé, haha.

Cependant il marche super bien visiblement, donc je n'aurais pas à bricoler dessus.

Je te remercie beaucoup pour ton effort. J'aurais probablement apprécié des commentaires dans le code pour comprendre, en bon néophyte, mais je comprends que tu ne t'y attardes pas.

Je remercie aussi beaucoup Mdo100, car tu as tout de même tenté une approche par formule comme je l'attendais initialement.
Je choisis la solution de Gmb car plus ergonomique et esthétique.

Encore merci à vous deux et bon weekend.

Bonsoir TotoEtTiti,

Merci pour ton retour Il est clair qu'à ta place j'aurai aussi choisi la solution de @gmb.

Bon dimanche.

Cdlt.

La même avec macro commentée.

Bye !

Hello gmb,

Tu as dû te tromper de fichier

Cdlt.

Bonjour à tous

Merci mdo100

Je rectifie :

Bye !

Re gmb,

Cool, merci pour ta disponibilité.

Bon dimanche.

Cdlt.

PS: Bien que je ne sois pas le demandeur, j'ose quand même te demander.

Comment ferais-tu pour calculer la dernière série de x, car par formule c'est la galère.

Merci.

Bye !

Bonsoir gmb,

Je crains de m'être mal expliqué, je souhaitais le même genre de code mais pour compter le nombre de "x" de la dernière série de chaque ligne.

Je te joins le fichier avec le résultat souhaité en colonne "N" de la feuille "Résumé"

Merci encore pour ta sollicitude.

Cdlt.

Hello gmb,

C'est exactement ça, merci encore pour ta bienveillance. en te souhaitant une belle journée.

Merci également à @TotoEtTiti, car je me suis permis de poser une question sur son #post.

Cordialement.