Discussion :

[tieumav]

Bonjour,

Je souhaiterais définir avec une macro la valeur mini qui a au minimum 3 occurrences consécutives dans une colonne.
Par exemple:
1
18
45
8
8
45
12
12
12
9
89
87

Ma valeur mini qui doit sortir serait : 12.

Pouvez-vous m'aider.
Merci

[geogeo70]

hello,

un algorithme courant est de trier la liste puis compter les nombres dans l'ordre jusqu'à trois égalités. J'ai fait une fonction qui rend la valeur mini si trois, il suffit dans la procédure d'essai de saisir la référence de liste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Function Valmini3(liste As Range) As Integer
 
    Dim i As Integer, j As Integer, n As Integer
 
    'tri de la liste
 
    Feuil1.Sort.SortFields.Add Key:=liste(1, 1)
    With Feuil1.Sort
        .SetRange liste
        .Apply
    End With
 
    i = 1    'compteur de ligne
    j = 1    'compteur de nombres égaux
    n = liste.Cells(1, 1)    'valeur courante
    While i <= liste.Count And j < 3   'arret si fin d'itération ou trois égalités
        If liste.Cells(i + 1, 1) = n Then
           j = j + 1
        Else
           n = liste.Cells(i + 1, 1) 'nouveau nombre
           j = 1
        End If
        i = i + 1
    Wend
    If j = 3 Then Valmini3 = n Else Valmini3 = 0 'ou autre si rien
End Function
 
Sub essai()
Dim liste As Range
Set liste = Range("A2:A13")                'ou liste selectionnée
Cells(1, 2) = Valmini3(liste)
End Sub

a++

geogeo70

[tieumav]

Le code permet de trouver la première valeur de la colonne qui se répète au minimum 3 fois.
Il ne permet pas de trouver la valeur mini de la colonne qui se répète au minimum 3 fois.
Par exemple:
3
25
25
25
11
11
11

Le résultat donner sera 25 et non 11 comme désiré.

Je ne vois pas comment introduire cette valeur mini.

[antonysansh]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Function MinAvecOccurrence(ByVal rg As Range, ByVal NbOcc As Long) As Double
    Dim t(), i&, j&, test As Boolean, res As Double, ok As Boolean
    test = True
    res = Application.WorksheetFunction.Max(rg)
    If rg.Columns.Count = 1 Then
        t = rg
        For i = LBound(t) To UBound(t) - (NbOcc - 1)
            For j = 0 To NbOcc - 1
                test = t(i, 1) = t(i + j, 1) And test
            Next
            If test Then
                res = Application.WorksheetFunction.Min(res, t(i, 1))
                ok = True
            Else
                test = True
            End If
        Next i
    Else
        MinAvecOccurrence = Error
        Exit Function
    End If
    If ok Then
        MinAvecOccurrence = res
    Else
        MinAvecOccurrence = -1
    End If
End Function

Tu peux, pour optimiser, stocker le min de ton range et tester si res = le min.
Car si on trouve comme résultat le minimum de la plage on sort de la boucle car on ne pourras pas trouver mieux.

[geogeo70]

bonjour,

voilà le résultat avec ta liste :


Les éléments étant triés les "11" sont avant les "25" donc résultat 11

geogeo70

[mercatog]

@ geogeo70

Si tu trie, tu fausses les données initiales

1, 2, 2, 2, 1, 4, 1, 6

Tu auras 1 alors qu'on cherche 2

[joe.levrai]

Bonjour,

une fonction personnalisée à mettre dans un module standard.
elle ne fonctionne que sur une seule colonne à la fois, et uniquement sur des nombres > - 1


je l'ai superficiellement testée, je te laisse bien vérifier que c'est ok

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Public Function TrioMini(Plage As Range)
Dim Tabl()
Dim i As Long
Dim ValMini As Long
 
    ValMini = -1
    ' la fonction ne travaille que sur une colonne
    If Plage.Columns.Count > 1 Then
        TrioMini = "#PlageMulticolonne"
        Exit Function
 
    Else
        ' on met toute la plage dans un tableau
        Tabl = Application.Transpose(Plage.Value)
 
        ' boucle sur tous les éléments (sauf les deux derniers)
        For i = LBound(Tabl) To UBound(Tabl) - 2
            ' si trois éléments à la suite sont égaux
            If Tabl(i) = Tabl(i + 1) And Tabl(i) = Tabl(i + 2) Then
                ' si on a pas encore stocké une valeur
                If ValMini = -1 Then
                    ' on prend directement la valeur trouvée
                    ValMini = Tabl(i)
                ' sinon, on regarde si la valeur trouvée est inférieure à la précédente valeur
                ElseIf Tabl(i) < ValMini Then
                    ValMini = Tabl(i)
                End If
            End If
        Next i
 
        If ValMini = -1 Then TrioMini = "#AucunTriplet" Else TrioMini = ValMini
        Exit Function
    End If
End Function

y'a encore de l'optimisation possible, comme arrêter la fonction quand on trouve un triplet successif dont la valeur est le minimum de la plage complète (par exemple)

[mercatog]

J'ajoute aussi ma proposition (qui n'est pas si différente)
j'ai pris en compte la proposition de joe.loverai

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Function MonMin(ByVal Rng As Range, ByVal NbOcc As Long)
Dim Res As Double, Tmp As Double, Mn As Double
Dim i As Long, j As Long
Dim Ok As Boolean
Dim T()
 
T = Rng: i = 1: Res = Application.Max(Rng): Mn = Application.Min(Rng)
Do
    If T(i + 1, 1) = T(i, 1) Then
        Tmp = T(i, 1)
        j = j + 1
        If j = NbOcc - 1 Then
            Res = Application.Min(Tmp, Res)
            Ok = True
            If Res = Mn Then Exit Do
            j = 0
        End If
    Else
        j = 0
    End If
    i = i + 1
Loop Until i = UBound(T)
MonMin = IIf(Ok, Res, "")
End Function

[antonysansh]

joe.levrai, mercatog et moi sommes plutôt en phase

Juste une petite question pour Joe.levrai :
mercatog et moi utilisons directement Tableau = Range quand toi tu préfères Tabl = Application.Transpose(Plage.Value)
Y a-t-il une raison particulière ou bien simplement pour te libérer d'un indice dans le tableau ?

[joe.levrai]

Etant donné qu'on travail sur une seule colonne, je transpose pour éviter d'utiliser un tableau de dimension 2 et de devoir toujours spécifier que je suis sur la dimension 1 (Tabl(x,1))

Ps : j'avais juste survolé ton code quand je l'ai vu (transport en commun .... téléphone) et là je vois qu'effectivement j'ai refais la même chose que toi grosso modo

[geogeo70]

mille excuses,

je n'avais pas lu "consécutives"...

Je viens de faire une nouvelle fonction (sans tri!) encore toutes mes excuses :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Function Valmini3bis(liste As Range) As Integer
 
    Dim i As Integer, n As Variant
    Dim Nb() As Integer
 
    Dim collect As Collection
    Dim petit As Integer
 
    Set collect = New Collection
 
    'liste en tableau
    ReDim Nb(liste.Count)
    For i = 1 To liste.Count
        Nb(i) = liste.Cells(i, 1)
    Next i
 
    'Décompte des valeurs égales
 
    i = 1    'compteur de ligne
 
    While i <= liste.Count - 2 'arret si fin d'itération
        If (Nb(i) = Nb(i + 1) And Nb(i + 1) = Nb(i + 2)) Then
                collect.Add (Nb(i))
        End If
        i = i + 1
    Wend
 
    ' choix du plus petit si trio
 
    If collect.Count <> 0 Then
         petit = collect.Item(1)
         For Each n In collect
            If petit > n Then petit = n
         Next n
         Valmini3bis = petit
    Else
         Valmini3bis = 0
    End If
 End Function

A++

geogeo

ou pour éviter le tableau,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Function Valmini3bis(liste As Range) As Integer
 
    Dim i As Integer, n As Variant
 
    Dim collect As Collection
    Dim petit As Integer
 
    Set collect = New Collection
 
 
    'Décompte des valeurs égales
 
    i = 1    'compteur de ligne
 
    While i <= liste.Count - 2 'arret si fin d'itération
        If (liste.Cells(i, 1) = liste.Cells(i + 1, 1) And liste.Cells(i + 1, 1) = liste.Cells(i + 2, 1)) Then
            collect.Add (liste.Cells(i, 1))
        End If
        i = i + 1
    Wend
 
    ' choix du plus petit si trio
 
    If collect.Count <> 0 Then
         petit = collect.Item(1)
         For Each n In collect
            If petit > n Then petit = n
         Next n
         Valmini3bis = petit
    Else
         Valmini3bis = 0
    End If
 End Function

salutations à vous

geogeo

et en affectant la liste à un tableau, semble assez rapide :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Function Valmini3ter(liste As Range) As Integer
 
    Dim i As Integer, n As Variant
    Dim Nb()
 
    Dim collect As Collection
    Dim petit As Integer
 
    Set collect = New Collection
 
    'liste en tableau
    Nb = liste
 
    'Décompte des valeurs égales
 
    i = 1    'compteur de ligne
 
    While i <= liste.Count - 2 'arret si fin d'itération
        If (Nb(i, 1) = Nb(i + 1, 1) And Nb(i + 1, 1) = Nb(i + 2, 1)) Then
            collect.Add Nb(i, 1)
        End If
        i = i + 1
    Wend
 
    ' choix du plus petit si trio
 
    If collect.Count <> 0 Then
         petit = collect.Item(1)
         For Each n In collect
            If petit > n Then petit = n
         Next n
         Valmini3ter = petit
    Else
         Valmini3ter = 0
    End If
 End Function

[patricktoulon]

Bonjour a tous
allez moi aussi j'ajoute ma contribs
je propose une solution un peu différente
pour moi la question est très simple

1 tu a une colonne avec des nombres
2 tu veux le plus petit qui a au moins 3 occurrences ou plus si j'ai bien compris
alors pour changer on utiliser un dictionnaire (tiens y en a qui vont peut être réagir )
et une variable tablo englobant la plage

je vais pas rallonger les commentaires qui sont déjà bien présent dans le code qui est d'une simplicité absolue

voila le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Option Explicit
Sub test()
    Dim tablo, dico As Object, i As Long, minimum As Long, index As Long
    With Sheets(1): tablo = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)): End With
    Set dico = CreateObject("scripting.dictionary")
    'on stoque les valeur dans un dico et leur nombres d'occurence dans la cle de chaque item respectif  du dico
    For i = 1 To UBound(tablo)
        If Not dico.exists(tablo(i, 1)) Then
            dico(tablo(i, 1)) = 1
        Else
            dico(tablo(i, 1)) = dico(tablo(i, 1)) + 1
        End If
    Next
    'ainsi si je fait msgbox dico(25) le message m'affichera 3
    'maintenant on veut le plus petit avec au moins 3 occurences
    ' alors on reprends le tablo
    For i = 1 To UBound(tablo)
        minimum = Application.Min(tablo) ' minimum nous donne le plus petit
        If dico(minimum) >= 3 Then MsgBox "yes!! c'est le  " & minimum & "  et il y a " & dico(minimum) & " occurences ": Exit For
        index = WorksheetFunction.Match(minimum, tablo, 0) 'on recupere l'index de ligne du tablo ou se trouve le plus petit
    tablo(index, 1) = 1000 'on le grossi pour ne plus passer par cette valeur (item du tableau)
    Next
End Sub

voila une capture d'écran qui montre le sheets le code et le résultat


voila

on peu même réduire le moulinet en bouclant sur le dico.count puisque forcement toutes les valeurs différentes du tableau s'y trouvent

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
For i = 1 To dico.Count
        minimum = Application.Min(tablo) ' minimum nous donne le plus petit
        If dico(minimum) >= 3 Then MsgBox "yes!! c'est le  " & minimum & "  et il y a " & dico(minimum) & " occurences ": Exit For
        index = WorksheetFunction.Match(minimum, tablo, 0) 'on recupere l'index de ligne du tablo ou se trouve le plus petit
    tablo(index, 1) = 1000 'on le grossi pour ne plus passer par cette valeur (item du tableau)
    Next

voila

[geogeo70]

il me semble Patrick que tu as oublié le mot "consécutives" comme moi au début ?

mais je peux me tromper...

geogeo

[mercatog]

Patrick, tu as loupé un détail

Avec ton code, tu peux récupérer des nombres non consécutifs!

L'exemple que j'ai donné @ geogeo70 sur son premier essai:
1, 2, 2, 2, 1, 4, 1, 6

Au boulot

[patricktoulon]

ou j'aurais oublié ce mot ??
quel rapport avec le code ?

[joe.levrai]

Hello,

Patrick, mélange tes 11 sur ta plage, ne le laisse pas à la suite
ils sont quand même détectés comme "minimum" sans pour autant être "consécutifs"


Et au passage, plutôt que de fixer arbitrairement 1000 comme valeur d'exclusion, met le max de la plage, tu seras tranquille


Ca faisait longtemps le coup du dictionnaire sorti de l'ombre

[patricktoulon]

Bonjour Mercatog ca faisait longtemps

d'accord j'avais pas loupé ce détail

bon ben voila c'est encore plus simple
toujours avec un dico et un tablo
allez test2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub test2()
    Dim tablo, dico As Object, i As Long, elem, minimum As Long
    With Sheets(1): tablo = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)): End With
    Set dico = CreateObject("scripting.dictionary")
    For i = 2 To UBound(tablo) - 1
        If tablo(i - 1, 1) + tablo(i, 1) + tablo(i + 1, 1) = tablo(i, 1) * 3 Then
            If Not dico.exists(tablo(i, 1)) Then dico(tablo(i, 1)) = ""
        End If
    Next
    minimum = 100000000
    For Each elem In dico
       minimum = IIf(elem < minimum, elem, minimum)
    Next
MsgBox "le plus petit chiffre qui a au moins 3 occurrences c'est le  " & minimum
End Sub

et pour finir après j'arrête parce que après il n'y aura plus de code

plus de dico , 1 seule boucle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test3()
Dim tablo, i As Long, minimum As Long
    minimum = 1000000000
    With Sheets(1): tablo = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)): End With
        For i = 2 To UBound(tablo) - 1
        If tablo(i - 1, 1) + tablo(i, 1) + tablo(i + 1, 1) = tablo(i, 1) * 3 Then
            minimum = IIf(tablo(i, 1) < minimum, tablo(i, 1), minimum)
        End If
    Next
    MsgBox "le plus petit chiffre qui a au moins 3 occurences consécutives ou plus   c'est le  " & minimum
End Sub

[joe.levrai]

Jolie la pirouette

j'espère juste que son triplet consécutif minimal ne soit pas 1 milliard + 1

allez fainéant, t'as fais la moitié du job

[patricktoulon]

au pire il ajoute un zéro ca fera 10 milliards
fainéant moi non jamais
logique oui
salut joe

allez va comma ca on élimine le problème du milliard
comme tu vois tres vite les solutions sont la
il suffit de prendre le maximum comme référence de début pour minimum

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub test3()
Dim tablo, i As Long, minimum As Long
    With Sheets(1): tablo = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)): End With
      minimum = Application.Max(tablo)
      For i = 2 To UBound(tablo) - 1
        If tablo(i - 1, 1) + tablo(i, 1) + tablo(i + 1, 1) = tablo(i, 1) * 3 Then
            minimum = IIf(tablo(i, 1) < minimum, tablo(i, 1), minimum)
        End If
    Next
    MsgBox "le plus petit chiffre qui a au moins 3 occurences ou plus   c'est le  " & minimum
End Sub

logique pas fainéant

[joe.levrai]

C'est bien parce que c'était une poussière à modifier que je t'ai traité de fainéant

Logique, on le sait tous que t'es taré


c'est juste que t'as pas du voir mon message : http://www.developpez.net/forums/d15...s/#post8523458


c'est pour ça que je te taquine