Excel - conditions multiples + recherche

'---pour accélérer---
Set inc = CreateObject("Scripting.Dictionary")
inc.CompareMode = vbTextCompare
For i = 0 To UBound(inclu)
  inc(inclu(i)) = ""
Next
'---liste sans doublon et concaténation des salaires---
For i = 2 To UBound(t)
  If inc.exists(t(i, col1)) Then
    salaire(i, 1) = t(i, col3)
    d(t(i, col2)) = d(t(i, col2)) & " " & salaire(i, 1)
  End If
Next

Option Explicit
Sub test()
Dim a, b(), x, w(), i As Long, n As Long, e, dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("Feuil2").Range("a1").CurrentRegion
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To 6)
        b(1, 1) = "Coefficient": b(1, 2) = "Nbre": b(1, 3) = "Mini"
        b(1, 4) = "Maxi": b(1, 5) = "Moyenne": b(1, 6) = "Médiane"
        n = 1
        For i = 2 To UBound(a, 1)
            If a(i, 1) <> "OUVRIER" And a(i, 1) <> "APPRENTI" Then
                If Not dic.exists(a(i, 2)) Then
                    n = n + 1
                    x = Filter(.Parent.Evaluate("transpose(if((" & .Columns(2).Address & _
                    "=" & Chr(34) & a(i, 2) & Chr(34) & ")*(" & .Columns(1).Address & _
                    "<>""ouvrier"")*(" & .Columns(1).Address & "<>""apprenti""),row(1:" & _
                    .Rows.Count & "),char(2)))"), Chr(2), 0)
                    x = Application.Index(.Value, Application.Transpose(x), [{3}])
                    ReDim w(1 To 2)
                    w(1) = n: w(2) = x
                    dic(a(i, 2)) = w
                End If
            End If
        Next
        For Each e In dic.keys
            w = dic(e)
            b(w(1), 1) = e
            b(w(1), 2) = Application.Count(w(2))
            b(w(1), 3) = Application.Min(w(2))
            b(w(1), 4) = Application.Max(w(2))
            b(w(1), 5) = Application.Average(w(2))
            b(w(1), 6) = Application.Median(w(2))
        Next
        Application.ScreenUpdating = False
        'restitution
        With Sheets("Feuil3").Range("a1")
            .CurrentRegion.Clear
            .Resize(n, 6).Value = b
            With .CurrentRegion
                .Sort .Columns(1), xlAscending, Header:=xlYes
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Columns(5).NumberFormat = "0"
                With .Rows(1)
                    .Interior.ColorIndex = 44
                    .BorderAround Weight:=xlThin
                    .HorizontalAlignment = xlCenter
                End With
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Option Explicit

Sub test()
Dim b(), e, y, z, x As String, n As Long
    Application.ScreenUpdating = False
    With Sheets("Feuil2").Cells(1).CurrentRegion
        ReDim b(1 To .Rows.Count, 1 To 6)
        b(1, 1) = "Coefficient": b(1, 2) = "Nbre": b(1, 3) = "Mini"
        b(1, 4) = "Maxi": b(1, 5) = "Moyenne": b(1, 6) = "Médiane"
        n = 1
        x = .Columns("b").Offset(1).Resize(.Rows.Count - 1).Address
        z = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & x & _
            ",0,0,row(1:" & .Rows.Count & "))," & x & ")=1," & x & ",char(2)))"), Chr(2), 0)
        'la fonction Filter ignore les "string" de longueur 0
        'donc j'ajoute la valeur "" en redimensionnant
        ReDim Preserve z(0 To UBound(z) + 1)
        For Each e In z
            y = Filter(.Parent.Evaluate("transpose(if((" & .Columns(2).Address & _
                "=" & Chr(34) & e & Chr(34) & ")*(" & .Columns(1).Address & _
                "<>""ouvrier"")*(" & .Columns(1).Address & "<>""apprenti""),row(1:" & _
                .Rows.Count & "),char(2)))"), Chr(2), 0)
            If UBound(y) > -1 Then
                y = Application.Index(.Value, Application.Transpose(y), [{3}])
                n = n + 1
                b(n, 1) = e
                b(n, 2) = Application.Count(y)
                b(n, 3) = Application.Min(y)
                b(n, 4) = Application.Max(y)
                b(n, 5) = Application.Average(y)
                b(n, 6) = Application.Median(y)
            End If
        Next
    End With
    'restitution
    With Sheets("Feuil3").Range("a1")
        .CurrentRegion.Clear
        .Resize(n, 6).Value = b
        With .CurrentRegion
            .Sort .Columns(1), xlAscending, Header:=xlYes
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns(5).NumberFormat = "0"
            With .Rows(1)
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
                .HorizontalAlignment = xlCenter
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

'---
  ReDim c(0 To UBound(s), 0 To 0) '2 dimensions nécessaires
  For j = 0 To UBound(s)
    If IsNumeric(s(j)) Then c(j, 0) = CDbl(s(j)) 'conversion
  Next

Sub test()
Dim c()
ReDim c(1 To 65536) '1er test
'ReDim c(1 To 65537) '2ème test
MsgBox Application.CountA(c)
End Sub