XL 2016 Occurrences maximum

[Joblender974]

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

X

2

X

X

X

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]

Bonjour.
Avec une fonction perso dans un module standard :

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 :

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

 

[JHA]

Bonjour à tous,

Un début de piste par formule

Bonjour Dranreb, trop fort cette fonction personnalisée.

JHA

 

[patricktoulon]

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

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

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

 

[Joblender974]

Bonjour.
Avec une fonction perso dans un module standard :

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 :

=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]

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]

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

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

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]

Bonjour.
Avec une fonction perso dans un module standard :

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 :

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

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

 

[Dranreb]

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

 

[Joblender974]

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]

Essayez comme ça :

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]

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

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

 

[Dranreb]

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

 

[Joblender974]

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]

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