Private Sub Worksheet_Calculate()
Dim plage As Range, cel As Range
Set plage = Range([B3], [B65536].End(xlUp)).SpecialCells(xlVisible)
If plage Is Nothing Then Exit Sub
[A2] = plage.Cells(1, 1)
[D3:D65536].ClearContents
For Each cel In plage
cel.Offset(, 2) = Application.Rank(cel.Offset(, 1), plage.Offset(, 1), 1)
Next
End Sub