Microsoft 365 suite de chiffres dans colonne

=SIERREUR(PETITE.VALEUR(SI(NON(NB.SI(B$1:B1;SI(ESTNUM(LN(EQUIV(A$2:A$9+1;A$2:A$9;0)>EQUIV(A$2:A$9;A$2:A$9;0)));A$2:A$9)));SI(ESTNUM(LN(EQUIV(A$2:A$9+1;A$2:A$9;0)>EQUIV(A$2:A$9;A$2:A$9;0)));A$2:A$9));1);"")

=SIERREUR(PETITE.VALEUR(SI(NON(NB.SI(B$1:B5;SI(ESTERREUR(LN(EQUIV(A$2:A$9+1;A$2:A$9;0)>EQUIV(A$2:A$9;A$2:A$9;0)));A$2:A$9)));SI(ESTERREUR(LN(EQUIV(A$2:A$9+1;A$2:A$9;0)>EQUIV(A$2:A$9;A$2:A$9;0)));A$2:A$9));1);"")

Option Explicit

Sub test()
Dim derA%, derB%, derC%, cellule As Range, myRange As Range, a%, i%
Dim newTable()

derA = Range("A" & Rows.Count).End(xlUp).Row
Range("B1:C" & derA + 1).ClearContents
derB = Range("B" & Rows.Count).End(xlUp).Row

For Each cellule In Range("A1:A" & derA)
Set myRange = Range("A" & cellule.Row & ":A" & derA)

    If Application.WorksheetFunction.CountIf(myRange, "=" & cellule + 1) > 0 Then _
        Range("B" & derB) = cellule: derB = derB + 1

Next cellule

newTable = Application.WorksheetFunction.Transpose(Range("B1:B" & derB - 1))
Range("C1").Resize(UBound(newTable), 1) = Application.Transpose(newTable)
a = Range("C1").End(xlDown).Row
Range("C1:C" & a).Sort key1:=Range("C1"), order1:=xlAscending
derB = Range("B" & Rows.Count).End(xlUp).Row + 1
For Each cellule In Range("A1:A" & derA)
    For i = 1 To UBound(newTable)
        If cellule = newTable(i) Then Exit For _
        Else
        If Application.CountIf(Range("B1:B" & derB), "=" & cellule) > 0 Then Exit For _
        Else
        Range("B" & derB + 1) = cellule
        derB = derB + 1
    Next i
Next cellule
derC = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("C" & a + 2 & ":C" & derB).Value = Range("B" & a + 2 & ":B" & derB).Value
Range("C" & a + 2 & ":C" & derB).Sort key1:=Range("C" & a + 2), order1:=xlAscending

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, resu(), i&, x As Variant, n&
Set d = CreateObject("Scripting.Dictionary")
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
    ReDim resu(1 To UBound(tablo), 1 To 2)
    For i = 1 To UBound(tablo)
        x = CStr(tablo(i, 1))
        If IsNumeric(x) Then
            x = CDbl(x)
            If Not d.exists(x) Then
                n = n + 1
                d(x) = n 'mémorise la ligne
                resu(n, 1) = x
            End If
            If d.exists(x - 1) Then resu(d(x - 1), 2) = 1 'repère 1 en 2ème colonne
        End If
    Next
    '---restitution---
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    With .Cells(2, 2) 'B2
        If n Then
            .Resize(n, 2) = resu
            .Resize(n, 2).Sort .Cells(1, 2), xlAscending, .Cells(1), , xlAscending, Header:=xlNo 'tri sur 2 colonnes
            i = Application.Count(.Cells(1, 2).Resize(n)) + 1 'fonction NB
            .Cells(1, 2).Resize(n).ClearContents
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1).ClearContents 'RAZ en dessous
        .Cells(i).Insert xlDown, xlFormatFromRightOrBelow 'formats du dessous 'séparation
    End With
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tablo, ub&, i&, x As Variant, j&
If FilterMode Then ShowAllData 'si la feuille est filtrée
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    tablo = .Resize(, 2) 'matrice, plus rapide
    ub = UBound(tablo)
    For i = 1 To ub
        x = CStr(tablo(i, 1))
        tablo(i, 2) = Empty
        If IsNumeric(x) Then
            x = CDbl(x) + 1
            For j = i + 1 To ub
                If tablo(j, 1) = x Then tablo(i, 2) = 1: Exit For 'repère 1 en 2ème colonne
            Next j
        End If
    Next i
    '---restitution---
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    With .Cells(1, 2) 'B1
        tablo(1, 1) = .Value
        tablo(1, 2) = 1
        .Resize(ub, 2) = tablo
        .Resize(ub, 2).Sort .Cells(1, 2), xlAscending, .Cells(1), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
        i = Application.Count(.Cells(1, 2).Resize(ub)) + 1 'fonction NB
        .Cells(1, 2).Resize(ub).ClearContents
        .Offset(ub).Resize(Rows.Count - ub - .Row + 1).ClearContents 'RAZ en dessous
        .Cells(i).Insert xlDown, xlFormatFromRightOrBelow 'formats du dessous 'séparation
    End With
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub