XL 2016 Occurrences maximum

Joblender974 · 25 Janvier 2022

Bonjour à tous!!!

Je suis bloqué depuis un bon moment, je ne parviens pas à trouver une solution à mon "problème" qui n'en sera sûrement pas un pour vous.

J'aimerai qu'Excel me donne la plus grande série d'une plage de donnée, mais que pour une valeur donnée, par exemple:

X

2

X

2
2
2

2

2
1

X

J'aimerai qu'Excel me donne la plus grande série de X unequement dans cette plage (même si la série de 2 est plus grande), donc que la cellule affiche 4.
Est-ce possible?

Merci beaucoup.

Dranreb · 25 Janvier 2022

Bonjour.
Avec une fonction perso dans un module standard :

VB:

Option Explicit

Function MaxContigus(ByVal R, ByVal V) As Double
   Dim T(), L As Long, Score As Long
   If TypeOf R Is Range Then T = R.Value Else T = R
   If TypeOf V Is Range Then V = V.Value
   For L = 1 To UBound(T, 1)
      If T(L, 1) = V Then
         Score = Score + 1
      Else
         If Score > MaxContigus Then MaxContigus = Score
         Score = 0
         End If
       Next L
   If Score > MaxContigus Then MaxContigus = Score
   End Function

En une cellule :

Code:

=MaxContigus($A$1:$A$40;"X")

JHA · 25 Janvier 2022

Bonjour à tous,

Un début de piste par formule

Bonjour Dranreb, trop fort cette fonction personnalisée.

JHA

patricktoulon · 25 Janvier 2022

Bonjour à tous
une autre méthode et version VBA/Formule

VB:

Function MaxOccurcontigue(p, b)
    Dim t, t2, I&, Q&
    t = p.Value
    t2 = Application.Transpose(t)
    For I = 1 To UBound(t)
        t2(I) = 0: If t(I, 1) = b Then Q = Q + 1: t2(I) = Q Else Q = 0: t2(I) = Q
    Next
    MaxOccurcontigue = WorksheetFunction.Large(t2, 1)
End Function

formule
=MaxOccurcontigue(A1:A26;"x")

par vba

VB:

Sub test()
    Set plage = Feuil1.Range("A1", Feuil1.Cells(Rows.Count, "A").End(xlUp))
    MsgBox MaxOccurcontigue(plage, "x")
End Sub

Joblender974 · 25 Janvier 2022

Dranreb à dit:

Bonjour.
Avec une fonction perso dans un module standard :

VB:

Option Explicit

Function MaxContigus(ByVal R, ByVal V) As Double
   Dim T(), L As Long, Score As Long
   If TypeOf R Is Range Then T = R.Value Else T = R
   If TypeOf V Is Range Then V = V.Value
   For L = 1 To UBound(T, 1)
      If T(L, 1) = V Then
         Score = Score + 1
      Else
         If Score > MaxContigus Then MaxContigus = Score
         Score = 0
         End If
       Next L
   If Score > MaxContigus Then MaxContigus = Score
   End Function

En une cellule :

Code:

=MaxContigus($A$1:$A$40;"X")

Merci beaucoup!! Le seul problème est que je n'ai jamais utilisé VBA. Je ne sais pas comment entrer tout ça. Je vais me renseigner.
Merci beaucoup en tout cas.

Joblender974 · 25 Janvier 2022

JHA à dit:
Bonjour à tous,

Un début de piste par formule

Bonjour Dranreb, trop fort cette fonction personnalisée.

JHA

Bonjour, merci beaucoup, je vais essayer d'utiliser ton fichier.

Joblender974 · 25 Janvier 2022

patricktoulon à dit:

Bonjour à tous
une autre méthode et version VBA/Formule

VB:

Function MaxOccurcontigue(p, b)
    Dim t, t2, I&, Q&
    t = p.Value
    t2 = Application.Transpose(t)
    For I = 1 To UBound(t)
        t2(I) = 0: If t(I, 1) = b Then Q = Q + 1: t2(I) = Q Else Q = 0: t2(I) = Q
    Next
    MaxOccurcontigue = WorksheetFunction.Large(t2, 1)
End Function

formule
=MaxOccurcontigue(A1:A26;"x")

par vba

VB:

Sub test()
    Set plage = Feuil1.Range("A1", Feuil1.Cells(Rows.Count, "A").End(xlUp))
    MsgBox MaxOccurcontigue(plage, "x")
End Sub

Bonjour, merci beaucoup. Comme plus haut, je ne comprends pas du tout VBA, je ne sais pas comment utiliser, je vais me renseigner.
Merci beaucoup.

Joblender974 · 25 Janvier 2022

Dranreb à dit:

Bonjour.
Avec une fonction perso dans un module standard :

VB:

Option Explicit

Function MaxContigus(ByVal R, ByVal V) As Double
   Dim T(), L As Long, Score As Long
   If TypeOf R Is Range Then T = R.Value Else T = R
   If TypeOf V Is Range Then V = V.Value
   For L = 1 To UBound(T, 1)
      If T(L, 1) = V Then
         Score = Score + 1
      Else
         If Score > MaxContigus Then MaxContigus = Score
         Score = 0
         End If
       Next L
   If Score > MaxContigus Then MaxContigus = Score
   End Function

En une cellule :

Code:

=MaxContigus($A$1:$A$40;"X")

En fait, ça m'affiche #NOM? . C'est sûrement moi qui ne comprend rien. Désolé .😩

Dranreb · 25 Janvier 2022

Alt+F11 pour entrer dans VBE, Alt+IM pour Insérer un module, coller le code dans la fenêtre de code.

Joblender974 · 25 Janvier 2022

Waou, c'est magique. Merci beaucoup, ça fonctionne.

Je peux pousser le bouchon un peu plus loin svp?

J'aimerais trois informations affichées en fait.

Par exemple: J'aimerai qu'Excel me donne aussi le nombre de fois où cette occurrence max est présente, dans cet exemple, l'occurrence max de "X" est 3, et elle apparait 2 fois.

Et si possible une cellule qui me donne la dernière date de la première occurrence max.

Voici un exemple:

	Occurrence max	Nbr occurrence max	Dernière date de la première occurence
	3	2	01/08/2008 20:30
08/04/2007 20:00				X
08/12/2007 21:00				X
01/08/2008 20:30				X
01/08/2008 21:00				2
01/08/2009 22:00				X
01/08/2010 23:30				X
09/02/2011 18:00				X
01/09/2012 16:00				2
01/09/2013 18:00				2
10/06/2014 19:00				2

Tout cela pour simplement dire à la fin si on prend l'exemple de ce tableau, "Le record d'apparition de X d'affilée est de 3, il a été atteint le 01/08/2008 à 20H30, ce record a été atteint 2 fois depuis cette date."

Je serais le plus heureux du monde si c'était possible de faire cela.
Je vous remercie d'avance.

Dranreb · 25 Janvier 2022

Essayez comme ça :

VB:

Function MaxContigus(ByVal R, ByVal V, ByVal K) As Double
   Dim T(), L As Long, Score As Long, TMax(1 To 3) As Long
   If TypeOf R Is Range Then T = R.Value Else T = R
   If TypeOf V Is Range Then V = V.Value
   If TypeOf K Is Range Then K = K.Value
   L = 1
   Do:
      Do While T(L, 1) <> V
         L = L + 1: If L > UBound(T, 1) Then Exit Function
         Loop
      Score = 0
      Do: Score = Score + 1
         L = L + 1: If L > UBound(T, 1) Then Exit Do
         Loop Until T(L, 1) <> V
      Select Case TMax(1)
         Case Is < Score: TMax(1) = Score: TMax(2) = 1: TMax(3) = L - 1
         Case Is = Score: TMax(2) = TMax(2) + 1
         End Select
      MaxContigus = TMax(K)
      Loop Until L > UBound(T, 1)
   End Function

Pour le K=3 vous devez utiliser un DECALER($A$1;MaxContigus($D$2:$D$40;"X";3);0)

Joblender974 · 25 Janvier 2022

Dranreb à dit:

VB:

Code:

Function MaxContigus(ByVal R, ByVal V, ByVal K) As Double
   Dim T(), L As Long, Score As Long, TMax(1 To 3) As Long
   If TypeOf R Is Range Then T = R.Value Else T = R
   If TypeOf V Is Range Then V = V.Value
   If TypeOf K Is Range Then K = K.Value
   L = 1
   Do:
      Do While T(L, 1) <> V
         L = L + 1: If L > UBound(T, 1) Then Exit Function
         Loop
      Score = 0
      Do: Score = Score + 1
         L = L + 1: If L > UBound(T, 1) Then Exit Do
         Loop Until T(L, 1) <> V
      Select Case TMax(1)
         Case Is < Score: TMax(1) = Score: TMax(2) = 1: TMax(3) = L - 1
         Case Is = Score: TMax(2) = TMax(2) + 1
         End Select
      MaxContigus = TMax(K)
      Loop Until L > UBound(T, 1)
   End Function

Je dois remplacer l'ancien par celui la? Désolé, je suis perdu.

Dranreb · 25 Janvier 2022

Oui bien sûr. Et mettre ';1)' à la fin de la 1ère formule.

Joblender974 · 25 Janvier 2022

Dranreb à dit:
Oui bien sûr. Et mettre ';1)' à la fin de la 1ère formule.

J'essaie mais je n'y arrive pas, XD, je vais persévérer et essayer de comprendre. Merci beaucoup en tout cas!!

Dranreb · 25 Janvier 2022

Double-cliquez sur le nom du module dans l'explorateur de projets pour le ravoir actif afin de le modifier.

XL 2016 Occurrences maximum

Joblender974

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

JHA

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

Joblender974

XLDnaute Nouveau

Joblender974

XLDnaute Nouveau

Joblender974

XLDnaute Nouveau

Joblender974

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Joblender974

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Joblender974

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Joblender974

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Discussions similaires

XL 2016 Occurrences maximum

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency