[COLOR=DarkSlateGray][B]Sub toto()
Dim i&, j&, k&, tmp
Dim oDat(), sDat(), oCml(), oColl As New Collection
With Application
.ScreenUpdating = 0: .Calculation = -4135
oDat = Range("B4").CurrentRegion.Value
With Range("K4")
sDat = Range(.Cells, .End(xlToRight)).Value
.CurrentRegion.ClearContents
.Cells.Resize(1, UBound(sDat, 2)).Value = sDat
Erase sDat
On Error Resume Next
For i = 2 To UBound(oDat, 1)
oColl.Add oDat(i, 2), CStr(oDat(i, 2))
Next i
On Error GoTo 0
If oColl.Count > 0 Then
ReDim sDat(1 To oColl.Count, 1 To 5)
For i = 2 To UBound(sDat, 1)
sDat(i, 1) = oColl(i)
Next i
For i = 1 To oColl.Count
tmp = oColl(i)
sDat(i, 1) = tmp
oCml = Array(Array(0, 0), Array(0, 0), Array(0, 0), Array(0, 0))
For j = 2 To UBound(oDat, 1)
If oDat(j, 2) = tmp Then
For k = 0 To 3
If Not IsEmpty(oDat(j, 4 + k)) Then oCml(k)(0) = oCml(k)(0) + oDat(j, 4 + k): oCml(k)(1) = oCml(k)(1) + 1
Next k
End If
Next j
For k = 0 To 3
If oCml(k)(1) > 0 Then sDat(i, k + 2) = oCml(k)(0) / oCml(k)(1)
Next k
Next i
.Offset(1, 0).Resize(UBound(sDat, 1), UBound(sDat, 2)) = sDat
End If
End With
.Calculation = -4105: .ScreenUpdating = 1
End With
End Sub[/B][/COLOR]