[VBA] Maximum d'une colonne indexé sur une autre colonne

Mettre le classeur sans données confidentielles en pièce jointe sur « mon-partage.fr »
et faire un clic droit-coller le raccourci  dans votre message 

Option Explicit
Option Base 1
'--------------------------------------------------------------------
Sub max_svt_secteur()
Dim D_max As Object
Dim Derlig As Integer, T_in, Cptr As Integer
Dim T_out, Lig As Integer, Lig_x As Integer, Col As Byte

''-------------initialisations
    Set D_max = CreateObject("scripting.dictionary")
    ReDim T_out(4, 1)
    With Sheets(1)
        'mémorisation RAM des données
        Derlig = .Columns("A").Find(what:="*", searchdirection:=xlPrevious).Row
        T_in = .Range("A2:D" & Derlig)
     End With
     'nettoyage restitution antérieure
     Sheets(2).Range("A2:C1000").Clear

'------------------mise en ordre id , secteur note maxi
        For Cptr = 1 To UBound(T_in)
            If Not D_max.exists(T_in(Cptr, 2)) Then
                'création du dictionnary clé=secteur, item =index du tablo de données
                Lig = Lig + 1
                ReDim Preserve T_out(4, Lig) 'tableau dynamique de restitition
                D_max.Add T_in(Cptr, 2), Lig  't_in(cptr,2)=secteur en cours, 1° ligne d'apparition
                For Col = 1 To 4
                    'affectation  tablo entrée vers tablo restitution
                    T_out(Col, Lig) = T_in(Cptr, Col)
                Next
            Else
                'si Note >  --->modif données
                Lig_x = D_max.Item(T_in(Cptr, 2)) 'rappel 1° ligne d'apparition du secteur
                If T_in(Cptr, 3) > T_out(3, Lig_x) Then
                    For Col = 1 To 4
                        T_out(Col, Lig_x) = T_in(Cptr, Col)
                   Next
                End If
           End If
        Next

'------------------restitution
    With Sheets(2)
        .Range("A2").Resize(D_max.Count, 4) = Application.Transpose(T_out)
        .Activate
    End With
End Sub

For j = 1 To nbConsumer_Discretionary
index = Evaluate("=MATCH(LARGE(IF(b2:b651=h3,c2:c651)," & j & "),c2:c651,0)")
refCellOptim.Offset(compteur, 0) = refCellSelec.Offset(index, 0)
refCellOptim.Offset(compteur, 1) = refCellSelec.Offset(index, 1)
refCellOptim.Offset(compteur, 2) = refCellSelec.Offset(index, 2)
compteur = compteur + 1
Next j
For j = 1 To nbConsumer_Staples
index = Evaluate("=MATCH(LARGE(IF(b2:b651=h4,c2:c651)," & j & "),c2:c651,0)")
refCellOptim.Offset(compteur, 0) = refCellSelec.Offset(index, 0)
refCellOptim.Offset(compteur, 1) = refCellSelec.Offset(index, 1)
refCellOptim.Offset(compteur, 2) = refCellSelec.Offset(index, 2)
compteur = compteur + 1
Next j