Compter la plus petite suite dans colonne
Bonjour à tous,
J'ai une colonne "A" dans laquelle j'ai des valeurs de 0 à 1. Je souhaiterais déterminer la plus petite suite disposant d'une valeur égale à 1.
Avez-vous une idée de comment je pourrais faire cela ? Merci à vous.
Exemple ci-dessous -> Plus petite suite en rouge, valeur à afficher : 3.
Bonjour,
Désolé pour l'usine à gaz
Option Explicit
Dim ValeurMini As Integer
Sub TestSuiteMini()
Dim DerniereLigne As Long, DerniereColonne As Long
Dim Sh As Worksheet
Set Sh = ActiveSheet
With Sh
DerniereLigne = .Cells(.Rows.Count, "A").End(xlUp).Row
DerniereColonne = .Cells.SpecialCells(xlCellTypeLastCell).Column + 1
SuiteMini .Range("A2:A" & DerniereLigne), DerniereColonne
.Range("A2:A" & DerniereLigne).Offset(0, DerniereColonne).ClearContents
With .Range("C1")
.Value = ValeurMini
.Activate
End With
If ValeurMini > 0 Then
MsgBox ValeurMini, vbInformation
Else
MsgBox "Aucune suite !", vbCritical
End If
End With
Set Sh = Nothing
End Sub
Sub SuiteMini(ByVal AireSuite As Range, ByVal ColonneOffset As Long)
Dim I As Long
Dim ValeurPrecedente As Integer, IndexMatrice As Integer
Dim MatriceSuite() As Variant
ValeurPrecedente = 0
ValeurMini = 0
IndexMatrice = 0
AireSuite(1).Offset(0, ColonneOffset) = AireSuite(1).Value
For I = 2 To AireSuite.Count
With AireSuite(I)
.Offset(0, ColonneOffset) = .Offset(-1, ColonneOffset) + .Value
End With
Next I
For I = 1 To AireSuite.Count
With AireSuite(I)
If .Offset(0, ColonneOffset) = 1 Then
ReDim Preserve MatriceSuite(1, IndexMatrice)
MatriceSuite(0, IndexMatrice) = "Suite " & IndexMatrice + 1
MatriceSuite(1, IndexMatrice) = MatriceSuite(1, IndexMatrice) + 1
ValeurPrecedente = 1
End If
If .Offset(0, ColonneOffset).Value > 1 And .Value = 1 And .Offset(0, ColonneOffset).Value > .Offset(-1, ColonneOffset).Value Then
If ValeurPrecedente = 0 Then
IndexMatrice = IndexMatrice + 1
ReDim Preserve MatriceSuite(1, IndexMatrice)
MatriceSuite(0, IndexMatrice) = "Suite " & IndexMatrice + 1
MatriceSuite(1, IndexMatrice) = MatriceSuite(1, IndexMatrice) + 1
ValeurPrecedente = 1
Else
MatriceSuite(1, IndexMatrice) = MatriceSuite(1, IndexMatrice) + 1
ValeurPrecedente = 1
End If
End If
If .Offset(0, ColonneOffset).Value > 1 And .Value = 0 And .Offset(0, ColonneOffset).Value = .Offset(-1, ColonneOffset).Value Then
ValeurPrecedente = 0
End If
End With
Next I
If IndexMatrice > 0 Then
ValeurMini = AireSuite.Count
For IndexMatrice = LBound(MatriceSuite, 2) To UBound(MatriceSuite, 2)
If MatriceSuite(1, IndexMatrice) < ValeurMini Then ValeurMini = MatriceSuite(1, IndexMatrice)
Next IndexMatrice
End If
End Subbonjour à tous
Hello Eric Kergresse
une approche différente via une fonction personnalisée, qui indique si une cellule donnée fait partie d'une des plus petites suites de cellules consécutives contenant un 1. Cette fonction renvoie vrai ou faux et peut être utilisée dans une MFC.
code de la fonction à mettre dans un module standard VBA
Function IsInMinSeq(plage As Range, celref As Range)
'determine si une cellule se trouve dans la plus petite suite de cellules consécutives contenant un 1, renvoie vrai ou faux
minseqlg = 99999
Set seqrange = Nothing
Set minseq = Nothing
For Each v In plage
If v = 1 Then
If seqrange Is Nothing Then Set seqrange = v Else Set seqrange = Union(seqrange, v)
ElseIf Not seqrange Is Nothing Then
If seqrange.Count < minseqlg Then
minseqlg = seqrange.Count
Set minseq = seqrange
ElseIf seqrange.Count = minseqlg Then
Set minseq = Union(minseq, seqrange)
End If
Set seqrange = Nothing
End If
Next v
IsInMinSeq = Not Application.Intersect(minseq, celref) Is Nothing
End Functionutilisation de la fonction
=IsInMinSeq(plage;celref)où :
plage : est la plage contenant la série de 0 et 1,
celref : cellule pour laquelle il faut déterminer si elle se trouve dans la plus petite suite de cellules consécutives contenant un 1)
re,
fonction adaptée avec une paramètre optional pour y inclure la possibilité de déterminer la longueur, d'afficher les adresses ou de déterminer si une cellule fait partie de la plus petite suite.
Bonsoir à tous
Via une formule matricielle en C2 :
=MIN(SIERREUR(EXP(LN(FREQUENCE(SI(A2:A21=1;LIGNE(A2:A21));SI(A2:A21<>1;LIGNE(A2:A21)))));""))
Excepté pour les récentes versions de Excel, une validation matricielle de cette formule est indispensable :
...
@mafraise,
très astucieux