Private Sub CommandButton1_Click()
Dim tablo, d1 As Object, d2 As Object, i&, resu, x As Variant, s, n&
With Sheets("Stocks").[A3].CurrentRegion 'adapter éventuellement
.Columns(3).Insert xlToRight 'colonne auxiliaire
.Columns(3) = "=--(""""&RC[1])" 'convertit en nombre ce qui peut être convertit
.Resize(, 10).Sort .Columns(3), xlAscending, .Columns(9), , xlAscending, Header:=xlYes 'tri sur 2 colonnes
tablo = .Columns(3).Resize(, 4) 'matrice, plus rapide
.Columns(3).Delete xlToLeft 'supprime la colonne auxiliaire
End With
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(tablo)
If IsNumeric(tablo(i, 1)) Then _
d1(tablo(i, 1)) = d1(tablo(i, 1)) & " " & i 'mémorise les numéros des lignes
Next
With [A1].CurrentRegion.Columns(7).Resize(, 2)
resu = .Value 'matrice, plus rapide
For i = 2 To UBound(resu)
resu(i, 2) = ""
x = resu(i, 1)
If IsNumeric(CStr(x)) Then
x = CDbl(x)
If d1.exists(x) Then
d2(x) = d2(x) + 1
s = Split(d1(x))
n = d2(x)
If n <= UBound(s) Then resu(i, 2) = tablo(s(n), 4)
End If
End If
Next
If FilterMode Then ShowAllData 'si la feuille est filtrée
.Value = resu 'restitution
End With
End Sub