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.