Minimum conditionnel en VBA

Sub test()
Dim i&, Grp$, D As Object, T As Variant
Set D = CreateObject("Scripting.dictionary")

With Sheets("Sheet1")
    T = .Range(.Cells(3, 2), .Cells(.Rows.Count, 2).End(3)(1, 2))
End With

For i = LBound(T, 1) To UBound(T, 1)
    Grp = Left(T(i, 1), Len(T(i, 1)) - 2)
    If Not D.exists(Grp) Then
        D(Grp) = T(i, 2)
    Else
        If T(i, 2) < D(Grp) Then D(Grp) = T(i, 2)
    End If
Next i

For i = LBound(T, 1) To UBound(T, 1)
    Grp = Left(T(i, 1), Len(T(i, 1)) - 2)
    T(i, 2) = D(Grp)
Next i

Sheets("Sheet1").Cells(3, 10).Resize(UBound(T, 1), UBound(T, 2)) = T
End Sub

Sub Résultat()
Dim resu As Range
With [B3:B10] 'à adapter
  .Name = "Base"
  .Offset(, 1).Name = "Valeur"
  Set resu = .Offset(, 3) 'decalage de 3 colonnes
End With
With resu(1)
  .FormulaArray = "=MIN(IF(LEFT(Base,LEN(Base)-2)=LEFT(RC[-3],LEN(RC[-3])-2),Valeur))"
  .AutoFill resu
End With
resu = resu.Value 'supprime les formules
End Sub