Formule matricielle en VBA... ou pas...

Sub test()
Dim i&, j&, k&, h&, d, s, p(), r()
  p = Worksheets("base simple").Range("matricule").Resize(, 4).Offset(, -1).Value
  h = UBound(p)
  ReDim q(1 To h, 2)
  For i = 2 To h: q(i, 0) = p(i, 2): q(i, 1) = i: q(i, 2) = p(i, 2) & Right$(String$(6, "0") & CLng(p(i, 4)), 6): Next
  For i = 2 To h - 1
    s = q(i, 2): d = q(i, 1)
    For j = i + 1 To h
      If s > q(j, 2) Then q(i, 2) = q(j, 2): q(j, 2) = s: s = q(i, 0): q(i, 0) = q(j, 0): q(j, 0) = s: s = q(i, 2): q(i, 1) = q(j, 1): q(j, 1) = d: d = q(i, 1)
    Next
  Next
  s = ""
  ReDim r(1 To 3, k)
  r(1, 0) = p(1, 1): r(2, 0) = p(1, 2): r(3, 0) = "Nombre de jours"
  For i = 2 To h
    If s = p(q(i, 1), 2) Then
      If d <> p(q(i, 1), 4) Then r(3, k) = r(3, k) + 1: d = p(q(i, 1), 4)
    Else
      s = p(q(i, 1), 2): d = p(q(i, 1), 4)
      k = k + 1
      ReDim Preserve r(1 To 3, k)
      r(1, k) = p(q(i, 1), 1): r(2, k) = p(q(i, 1), 2): r(3, k) = 1
    End If
  Next
  For i = 2 To k - 1
    s = r(2, i)
    For j = i + 1 To k
      If s > r(2, j) Then r(2, i) = r(2, j): r(2, j) = s: s = r(1, i): r(1, i) = r(1, j): r(1, j) = s: s = r(3, i): r(3, i) = r(3, j): r(3, j) = s: s = r(2, i)
    Next
  Next
  With Worksheets("Filtre").Range("A1"): .CurrentRegion.ClearContents: .Resize(k + 1, 3).Value = WorksheetFunction.Transpose(r): End With
End Sub