Ranking dynamique

Bonjour,

Je cherche à faire évoluer l'ordre d'élément de manière dynamique.

Pour l'exemple, j'ai une liste d'éléments avec un ordre pré-défini :

Element A 1

Element B 2

Element C 3

Element D 4

Je décide que l'élément D doit être en deuxième position. Les éléments B et C doivent alors automatiquement et respectivement devenir 3 et 4 :

Element A 1

Element D 2

Element B 3

Element C 4

Cela parait simple mais après plusieurs heures de recherches, je sèche...

Je suis ouvert au VBA

D'avance merci pour vos idées

Bonjour,

Un classeur exemple serait plus explicite

On ne sait pas si tout est sur une colonne ou deux colonnes,

données venant de liens ou de formule ou en dur

Bonjour et merci,

Je ne parviens pas à répondre et ajouter un fichier... A chaque fois je dois me reconnecter à mon profil...

Et biensur quand j'écris cela, cela fonctionne...

Bonjour,

Sans VBA, tu ne pourras pas faire varier le ranking de toutes les autres cellules en n'en changeant qu'une. (du moins pas à ma connaissance)

Merci, pas de soucis pour utiliser VBA, une proposition ?

Ecoute, je me surprends de jour en jour, ça a l'air de fonctionner ...

Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("E4:E100")) Is Nothing Then
        For Each cell In Range("E4:E100")
            If cell.Address <> Target.Address Then
                If cell.Value = Target.Value Then cell.Value = cell.Value + 1
            Else: End If
        Next
    End If
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("D4:E100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

À ne pas mettre dans un module, mais sur ta feuille, dans l'éditeur VBE.

Je ne promets pas une fiabilité à toute épreuve, je suis débutant en VBA

Déjà merci,

Je vais tester ca et je reviens vous dire

Super, ca marche effectivement pas mal.

Par contre, uniquement dans un sens... Si on diminue une valeur, cela fonctionne, par contre si on l'augmente, le chiffre d'rigine disparait de la liste... Une idée d'amélioration ?

J'ai ajouté un tri automatique :

Je n'ai pas réussi à l'ajouter dans un cadre code...

Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("E4:E100")) Is Nothing Then

For Each cell In Range("E4:E100")

If cell.Address <> Target.Address Then

If cell.Value = Target.Value Then cell.Value = cell.Value + 1

Else: End If

Next

End If

With ActiveWorkbook.ActiveSheet.Sort

.SetRange Range("D4:E100")

.Header = xlGuess

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

With ActiveWorkbook.Worksheets("Feuil2").AutoFilter.Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

End Sub

il me semblait pourtant que c'était déjà un tri ...

 With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range("D4:E100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Pour ce qui est du beug dans l'autre sens, effectivement, je n'avais pas prévu ça.

Si d'autres veulent s'y mettre, je veux bien, je ne suis pas là cet après-midi.

Ha oui, c'est vrai, il était déjà dedans... J'affinerai ca.

Après, si personne d'autre ne s'y met, je peux attendre...

Merci encore

Mais en fait, quand bien même je serais disponible, je suis une bille an algorithmique.

Et là, le cas se complique un peu quand même si on veut que ça fonctionne tout le temps.

Il faut qu'au changement de valeur, ça scanne toutes les cellules de ta colonne E.

Le souci, c'est qu'on ne peut pas récupérer la valeur de la cellule avant changement. Donc il faudrait arriver à voir quelle valeur est manquante dans ta nouvelle liste, ne rien faire à toutes les valeurs plus basses, et ... et rien que là, je m'y perds.

Le sujet est super intéressant, mais n'est pas pour moi, désolé.

Je m'en remets également à plus calé

bonjour,

une proposition (données en A1:Bn)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column <> 2 Then Exit Sub
    nouv = Target.Value
        Application.EnableEvents = False
    Application.Undo
    ancv = Target.Value
    dl = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 1 To dl
       If ancv > nouv Then
       If Cells(i, 2) >= nouv And Cells(i, 2).Address <> Target.Address Then Cells(i, 2) = Cells(i, 2) + 1
       Else
       If Cells(i, 2) <= nouv And Cells(i, 2).Address <> Target.Address Then Cells(i, 2) = Cells(i, 2) - 1
       End If
    Next i
    Target = nouv
    Range("A1:B" & dl).Sort key1:=Range("B1"), order1:=xlAscending, Header:=xlNo
    For i = 1 To dl
        Cells(i, 2) = i
    Next i
    Application.EnableEvents = True
End Sub

Super, je vous remercie tous, cela me sera très utile.

JoyeuxNoel a écrit :

Le souci, c'est qu'on ne peut pas récupérer la valeur de la cellule avant changement.

nouv = Target.Value
        Application.EnableEvents = False
    Application.Undo
    ancv = Target.Value

Oui, non, mais Ok ...d'accord ... si on triche, on peut

Super h2s04, un immense merci pour ça. Jamais je n'y aurais pensé en tout cas, et j'aime à croire que ça me sera bien utile pour la suite