Bonjour,
Voilà en VBA
Sub ApplicationFormule()
Dim DerLig_Liste As Long, DerLig_Extract As Long, i As Long, j As Long
Application.ScreenUpdating = False
DerLig_Liste = Range("A" & Rows.Count).End(xlUp).Row
'Constitution de la liste des véhicule
Range("A3:A16").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F3"), Unique:=True
'Triplement de chaque véhicule
DerLig_Extract = Range("F" & Rows.Count).End(xlUp).Row
For i = DerLig_Extract To 4 Step -1
For j = 1 To 2
Cells(i, "F").Copy
Cells(i, "F").Insert Shift:=xlDown
Next j
Next i
'tri de la colonne F par ordre alphabétique
DerLig_Extract = Range("F" & Rows.Count).End(xlUp).Row
Range("F4:F" & DerLig_Extract).Sort [F3], 1
'Application de la formule
Range("G4").FormulaR1C1 = "=SUMPRODUCT(LARGE((R4C1:R" & DerLig_Liste & "C1=RC6)*(R4C2:R" & DerLig_Liste & "C2),COUNTIF(R4C6:RC6,RC6)))"
Range("G4").AutoFill Destination:=Range("G4:G" & DerLig_Extract)
'Remplacement de la formule par les valeurs obtenues
Range("G4:G" & DerLig_Extract).Value = Range("G4:G" & DerLig_Extract).Value
'Suppression des véhicules avec la valeur = à 0
For i = DerLig_Extract To 4 Step -1
If Cells(i, "G") = 0 Then Range(Cells(i, "F"), Cells(i, "G")).Delete
Next i
End Sub
Cdlt