Sub Formule()
Dim t#
t = Timer
With ActiveSheet.ListObjects(1).Range 'tableau structuré
.Columns(3).Offset(1) = "" 'RAZ
.Cells(2, 3).FormulaArray = "=MAX(IF([" & .Cells(1) & "]=[@" & .Cells(1) & "],[" & .Cells(1, 2) & "]))"
End With
[H3] = Format(Timer - t, "0.00 \s")
MsgBox "Durée " & [H3]
End Sub
Sub Tableaux_VBA()
Dim t#, d As Object, tablo, resu(), i&, x$, y, n&
t = Timer
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée (si textes)
With ActiveSheet.ListObjects(1).Range 'tableau structuré
tablo = .Resize(, 2) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 1)
resu(1, 1) = .Cells(1, 3) 'en-tête
For i = 2 To UBound(tablo)
x = CStr(tablo(i, 1)): y = tablo(i, 2)
If Not d.exists(x) Then d(x) = i 'mémorise la ligne
If IsNumeric(y) Then n = d(x): If CDbl(y) > resu(n, 1) Then resu(n, 1) = CDbl(y)
Next
For i = 2 To UBound(tablo)
resu(i, 1) = resu(d(CStr(tablo(i, 1))), 1)
Next
'---restitution---
.Columns(3) = resu
End With
[H6] = Format(Timer - t, "0.00 \s")
MsgBox "Durée " & [H6]
End Sub