Function КСОВП(rng1 As Range, rng2 As Range)
For Each cl2 In rng2.Cells
    For Each cl1 In rng1.Cells
        If cl1 = cl2 Then КСОВП = КСОВП + 1
    Next
Next
End Function

Sub test()
    Dim rngData As Range, rngCriteria As Range, rngList As Range, c As Range
    Dim arrCriteria(), arr(), i
    
    With Worksheets(1)
        Set rngData = .Range(.Cells(4, 3), Cells(.Rows.Count, 3).End(xlUp))
        Set rngCriteria = .Range(.Cells(4, 5), Cells(.Rows.Count, 5).End(xlUp))
        Set rngList = .Cells(12, 8)
    End With
    
    Application.ScreenUpdating = False
    arrCriteria = rngCriteria.Value
    ReDim Preserve arr(0)
    For Each i In arrCriteria
        Set c = rngData.Find(What:=i, LookIn:=xlValues)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                Set c = rngData.FindNext(c)
                arr(UBound(arr)) = c.Row - rngData(1, 1).Row + 1
                ReDim Preserve arr(UBound(arr) + 1)
                Debug.Print c.Address
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    Next i
    ReDim Preserve arr(UBound(arr) - 1)
    With rngList.Resize(UBound(arr) + 1, 1)
        .Value = Application.Transpose(arr)
        .Sort Key1:=rngList.Offset(-1, 0), Header:=xlYes
    End With
    Application.ScreenUpdating = True
End Sub

arr(UBound(arr)) = c.Row - rngData(1, 1).Row + 1

arr(UBound(arr)) = c.Row