XL 2019 supprimer exequos dans un classement de tournoi

job75 à dit:

Bonjour Mimi1952,

J'avoue ne pas avoir vraiment compris ce que vous avez fait.

Voyez quand même le fichier joint et cette macro affectée au bouton :

VB:

Sub Classement()
Dim c As Range, n&, a(), nn&
For Each c In Feuil8.Columns("I").SpecialCells(xlCellTypeConstants)
    If n Mod 2 Then
        If c(1, 6) > a(1, nn) Then a(0, nn) = c(1, 2): a(1, nn) = c(1, 6)
    Else
        nn = n / 2
        ReDim Preserve a(1, nn) 'base 0
        a(0, nn) = c(1, 2)
        a(1, nn) = c(1, 6)
    End If
    n = n + 1
Next
'---restitution dans la feuille Classement---
Feuil2.[B4].Resize(nn + 1, 2) = Application.Transpose(a)
Feuil2.Activate
End Sub

A+

Cliquez pour agrandir...