Sub Main()
Dim Res
Call Fileter_CriteriaS(Res, [F5:F19], [B5:B19], [M5], [C5:C19], [N5])
If IsArray(Res) Then [O18].Resize(UBound(Res), UBound(Res, 2)) = Res
End Sub
Sub Fileter_CriteriaS(ByRef Res, ByVal rng As Range, ParamArray crit())
Dim aRow(), sRow&, sCol&, i&, k&, j&, c&
sRow = crit(0).Rows.Count: sCol = rng.Columns.Count
If sRow <> rng.Rows.Count Then Exit Sub
ReDim aRow(1 To sRow)
For j = LBound(crit) To UBound(crit) Step 2
If sRow <> crit(j).Rows.Count Then Exit Sub
Next j
For i = 1 To sRow
For j = LBound(crit) To UBound(crit) Step 2
If crit(j)(i, 1) <> crit(j + 1) Then Exit For
Next j
If j = UBound(crit) + 1 Then
k = k + 1
aRow(k) = i
End If
Next i
If k Then
ReDim Res(1 To k, 1 To rng.Columns.Count)
For i = 1 To k
For j = 1 To sCol
Res(i, j) = rng(aRow(i), j)
Next j
Next i
End If
End Sub
Function LocMang(ByVal rng As Range, ParamArray crit()) As Variant
Dim aRow(), Res(), sRow&, sCol&, i&, k&, j&, c&
sRow = crit(0).Rows.Count: sCol = rng.Columns.Count
If sRow <> rng.Rows.Count Then LocMang = "#REF!": Exit Function
ReDim aRow(1 To sRow)
For j = LBound(crit) To UBound(crit) Step 2
If sRow <> crit(j).Rows.Count Then LocMang = "#REF!": Exit Function
Next j
For i = 1 To sRow
For j = LBound(crit) To UBound(crit) Step 2
If crit(j)(i, 1) <> crit(j + 1) Then Exit For
Next j
If j = UBound(crit) + 1 Then
k = k + 1
aRow(k) = i
End If
Next i
If k Then
ReDim Res(1 To k, 1 To rng.Columns.Count)
For i = 1 To k
For j = 1 To sCol
Res(i, j) = rng(aRow(i), j)
Next j
Next i
LocMang = Res
End If
End Function
