Lister et dénombrer

Bonjour, j'ai une colonne dans laquelle je voudrais lister toutes les suites de 3 nombres (sans doublon) en les comptant.

Je joins un exemple (j'ai environ 1500 valeurs)

Merci

Bonjour,

pourquoi en remontant ?
Ca ne change rien par rapport à en descendant non ? Ou alors tu ne dis pas tout.
eric

bonjour,

salut eriiic

une proposition

Sub aargh()
    Dim k(2), t, i&, j&, i1&, i2&, cle, dict, doublon, dl&
    With Sheets("feuil1")
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dict = CreateObject("scripting.dictionary")
        t = .Range("A1").Resize(dl, 1).Value
        For i = 1 To dl - 3
        'on prend 3 nombres consécutifs
            For j = 0 To 2
                k(j) = t(i + j, 1)
            Next j
            doublon = False
            'tri des 3 nombres
            For i1 = 0 To 1
                For i2 = i1 To 2
                    If k(i1) > k(i2) Then a = k(i1): k(i1) = k(i2): k(i2) = a
                Next i2
                If k(i1) = k(i1 + 1) Then doublon = True:exit for '2 nombres identiques dans la série de 3 nombres
            Next i1
            If Not doublon Then
                cle = Join(k, "|")
                dict(cle) = dict(cle) + 1 'incrémente cette occurrence de 3 nombres
            End If
        Next i
        'affichage du résultat
        .Range("D1").Resize(dict.Count, 1) = Application.Transpose(dict.keys)
        .Range("E1").Resize(dict.Count, 1) = Application.Transpose(dict.items)
    End With
End Sub

bonjour

merci h2so4 pour ton code que je vais tester.

Eric, 123 c'est différent de 321...

l'ordre est important. Il faut remonter par 3 lignes glissantes

merci

que tu comptes les 1,2,3 en descendant ou les 3,2,1 en montant c'est exactement pareil.
A moins que les chevauchements soient interdits (?) et que les valeurs ne soient pas un multiple de 3.

Et oui, tu n'avais pas dit non plus que l'ordre comptait, d'où une proposition erronée d'h2so4 qui comme moi, supposait qu'il ne fallait pas tenir compte de l'ordre
eric

re-bonjour,

en effet, j'ai mal compris la demande.

Option Explicit
Sub aargh()
    Dim t, i&, cle$, dict, dl&, a, b, c
    With Sheets("feuil1")
        .Range("D:Z").Delete
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        Set dict = CreateObject("scripting.dictionary")
        t = .Range("A1").Resize(dl, 1).Value
        For i = 1 To dl - 2
            'on prend 3 nombres consécutifs
            a = t(i + 2, 1)
            b = t(i + 1, 1)
            c = t(i, 1)
            If a = b Or a = c Or b = c Then
            Else
                cle = a & " " & b & " " & c
                dict(cle) = dict(cle) + 1 'incrémente cette occurrence de 3 nombres
            End If
        Next i
        'affichage du résultat
        .Range("D1").Resize(dict.Count, 1) = Application.Transpose(dict.keys)
        .Range("G1").Resize(dict.Count, 1) = Application.Transpose(dict.items)
        .Range("D1").Resize(dict.Count, 4).Sort key1:=.Range("G1"), order1:=xlDescending, Header:=xlNo
        .Range("D1").Resize(dict.Count, 1).TextToColumns Space:=True
    End With
End Sub

Merci beaucoup H2so4, c'est parfait comme résultat.

A bientôt

Je partage l'avis d'eriiic. Une macro dans l'ordre descendant que j'ai testée pour le fun dans l'ordre montant : même résultat, ce qui est normal.