[VBA/Excel] Trouver les grandes valeurs d'un

dim tablo()  

ReDim Preserve tablo(1 to UBound(D), 1 to UBound(R, 2) - 1)  

Type tabloStructure 
  Tab_1 As Integer 
  Tab_2 As Integer 
  Tab_3 As Integer 

End Type 
Sub test2() 
Dim monTablo() As tabloStructure 

ReDim monTablo(0) 
ReDim Preserve monTablo(3) 

monTablo(1).Tab_1 = 4 
monTablo(2).Tab_2 = 5 
monTablo(3).Tab_3 = 10 

MsgBox monTablo(1).Tab_1 
MsgBox monTablo(1).Tab_2 
MsgBox monTablo(1).Tab_3 
End Sub 

Sub MaxVal()
    Dim LastLg As Integer
    Dim LastRw As Integer

    With Sheets("feuil1")
        '.Range("J1:M" & .[A65000].End(xlUp).Row).Clear
        .Range("J1:M" & .[A65000].End(xlUp).Row).Delete Shift:=xlUp
        
        LastLg = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LastLg).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range( _
                                                                                  "J1"), Unique:=True
        .[K1] = .[B1]
        .[L1] = .[F1]
        .[M1] = .[G1]

        With .Range("J1:M1")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        ' Ca ne marche pas encore !!
        .Range("J1:M1").Interior.ColorIndex = .[A1].Interior.ColorIndex

        LastRw = .Range("J" & Rows.Count).End(xlUp).Row

        ' Ca ne marche pas encore!!
        With .Range("J1:M" & LastRw)
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlHairline
            End With
        End With

        MsgBox " LastLg = " & LastLg

        .Range("A2:A" & LastLg).Name = "Objet"
        .Range("B2:B" & LastLg).Name = "NCS"
        .Range("F2:F" & LastLg).Name = "QS"
        .Range("G2:G" & LastLg).Name = "QT"
    End With

    'SI(J2<>"";MAX(MAX(SI((A$2:A$33=J2)*(F$2:F$33=L2);B$2:B$33));MAX(SI((A$2:A$33=J2)*(G$2:G$33=M2);B$2:B$33)));"")
    Range("K2").FormulaArray = _
    "=IF(J2<>"""",MAX(MAX(IF((Objet=J2)*(QS=L2),NCS)),MAX(IF((Objet=J2)*(QT=M2),NCS))),"""")"
    Range("K2").AutoFill Destination:=Range("K2:K" & LastLg)

    'SI($J2<>"";MAX(SI(($A$2:$A$33=$J2)*($B$1:$G$1=L$1);$B$2:$G$33));"")
    Range("L2").FormulaArray = _
    "=IF($J2<>"""",MAX(IF((Objet=$J2)*($B$1:$G$1=L$1),$B$2:$G$" & LastLg & ")),"""")"
    Range("L2").AutoFill Destination:=Range("L2:L" & LastLg)

    '=SI($J2<>"";MAX(SI(($A$2:$A$33=$J2)*($B$1:$G$1=M$1);$B$2:$G$33));"")
    Range("M2").FormulaArray = _
    "=IF($J2<>"""",MAX(IF((Objet=$J2)*($B$1:$G$1=M$1),$B$2:$G$" & LastLg & ")),"""")"
    Range("M2").AutoFill Destination:=Range("M2:M" & LastLg)

    Range("L2:L" & LastLg).NumberFormat = "0.00%"
    Range("M2:M" & LastLg).NumberFormat = "0.00%"

End Sub

Sub GrandesValeurs()
    Dim D() As Variant, R() As Variant
    Dim d1 As Object
    Dim C As Range    '! Single, #DOuble
    Dim temp$, temp1!, temp2!, L1%, L2%, i As Byte, j As Byte
    Dim temp11!, temp22!, NS$
    Dim Tbl() As tabloStructure

    Set d1 = CreateObject("Scripting.Dictionary")
    R = Range("A2:G" & [A65000].End(xlUp).Row)

    For Each C In Range("A2", [A65000].End(xlUp))
        temp = C.Value
        If Not d1.exists(temp) Then
            d1.Add temp, temp
        End If
    Next C
    D = d1.keys    'Obtient les éléments

    ReDim Tbl(0)
    ReDim Preserve Tbl(4)
    temp = 0    'NCS
    temp1 = 0    'QS
    temp2 = 0    'QT
    NS = ""
    L1 = 1: L2 = 1
    
    For i = 0 To UBound(D)
        For j = LBound(R) To UBound(R)
            If D(i) = R(j, 1) Then
                L1 = j: L2 = j
                If R(j, 6) >= temp1 Then
                    temp11 = temp1
                    temp1 = R(j, 6)
                    'L1 = j
                    NS = NS & "|" & R(j, 2)
                End If
                If R(j, 7) >= temp2 Then
                    temp22 = temp2
                    temp2 = R(j, 7)
                    'L2 = j
                    NS = NS & "|" & R(j, 2)
                End If
            End If
        Next j
        Dim N$()
        N = Split(NS, "|")
        temp = Application.Max(UBound(N))

        Tbl(i + 1).Tab_1 = temp: Tbl(i + 1).Tab_2 = temp1: Tbl(i + 1).Tab_3 = temp2

    Next i
    Range("K2").Resize(d1.Count + 1) = Application.Transpose(d1.keys)
    'Range("K2").Resize(UBound(Tbl), 4) = Tbl
End Sub