Microsoft 365 suite de chiffres dans colonne

[perrmi]

bonjour a vous tous
Petit problème de ce samedi matin
voir fichier joint.
une suite de chiffres dans une colonnes
les reclasser si ces chiffres ont un nombre directement supérieur dans cette meme colonne.
ex un numéro 5 a bien le nombre 6 dans la colonne je l'affiche donc...
merci a vous tous
bonne journée
Michel

 

[youky(BJ)]

Bonjour Perrmi,
en B1 =SI(NB.SI(A1:A$10;A1+1)>0;A1;"")
en C1 =SI(NB.SI(A1:A$10;A1+1)=0;A1;"")

Tirer les formules en bas
Bruno

 

[job75]

Bonjour permi, Bruno,

Joli problème.

Formule matricielle en B2 à tirer vers le bas :

=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);"")

A partir de la 2ème cellule vide (B6) remplacer ESTNUM par ESTERREUR :

=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);"")

Sur MS 365 la validation matricielle n'est pas nécessaire.

A+

 

[perrmi]

Super merci bien
pour vos 2 bonnes réponses
impressionné quand même
chapeau bas

Bonne journée a vous 2
perrmi

 

[perrmi]

Bonjour permi, Bruno,

Joli problème.

Formule matricielle en B2 à tirer vers le bas :

=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);"")

A partir de la 2ème cellule vide (B6) remplacer ESTNUM par ESTERREUR :

=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);"")

Sur MS 365 la validation matricielle n'est pas nécessaire.

A+

je constate cependant que si la colonne A =3-5-7-1-8-4-2-6
le numéro 7 n'apparait pas dans la colonne formule B (pourtant le numéro 8 suivant est bien dans la colonne A)

 

[job75]

Vous n'avez pas bien suivi le processus que j'ai indiqué, voyez le fichier joint.

 

[perrmi]

vraiment désolé vous avez raison
merci a vous et de votre patience
bonne journée
perrmi

 

[job75]

Ce qu'il faut bien comprendre c'est que chaque fois qu'on modifie la colonne A il faut retirer/modifier les formules en colonne B.

Si on veut automatiser cette mise à jour il faut une macro VBA.

 

[youky(BJ)]

Bonjour Gérard,
J'avais pas vu qu'il fallait trier, par contre j'avais modifié ma formule pour y inclure parfois des x.
N'étends pas sur de moi sur ces x j'ai rien envoyé et tu es intervenu.
Je vois que tu ne mets pas de x.
Y a du VBA dans l'air . . . .
Bruno

 

[Wayki]

Bonjour,
Avec du VBA, sans doute peut-il être amélioré :

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

Cependant attention à bien vider les plages en dessous des données sinon elles vont se greffer n'importe où !
J'oubliais, il faut placer ce code dans le module de la feuille
A +

 

[job75]

Bonjour Waiky,

Si on veut automatiser cette mise à jour il faut une macro VBA.

Et elle est conséquente, voici la mienne, dans le code de la feuille :

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

Elle se déclenche automatiquement quand on modifie ou valide une cellule quelconque.

Edit : ajouté à l'insertion xlFormatFromRightOrBelow pour ne pas copier B1.

 

[job75]

Avec la macro précédente, grâce au Dictionary, les doublons sont supprimés s'il y en a.

Celle-ci les conserve :

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

Sur un grand tableau c'est nettement moins rapide.