Сравнение слов и при совпадении, вытаскивание рядом чисел

arInd(ind, 1) = cntMtch 'на
arInd(ind, 1) >= cntMtch

Function FindMatches_(arr1(), arr2(), arr3(), cntMtch&) As Variant() 'v 26.06.24
    Dim row&, clm&, row2&, clm2&, k&, cnt&, clCnt&, ind&, arInd&(), arrOut(), dct As Object
        
    clCnt = UBound(arr3, 2)                              'кол-во столбцов исх. данных
    ReDim arrOut(1 To UBound(arr3), 1 To clCnt)          'результирующий массив
    Set dct = CreateObject("Scripting.Dictionary")       'словарь для поиска совпадений
    ReDim arInd(10000, 1)                                'массив для записи совпадений, их количеств и строк, в которых эти совпадения встретились
    
    For row = 1 To UBound(arr2)
        For clm = 1 To UBound(arr2, 2)
            If Len(arr2(row, clm)) > 0 Then
                If Not dct.Exists(arr2(row, clm)) Then
                    dct.Add arr2(row, clm), row
                End If
            End If
        Next
    Next
    
    For row = 1 To UBound(arr1)
        cnt = 0
        For clm = 1 To UBound(arr1, 2)
            If dct.Exists(arr1(row, clm)) Then
                cnt = cnt + 1
                row2 = dct(arr1(row, clm))
                If cnt = cntMtch Then
                    For clm2 = 1 To clCnt
                        arrOut(row, clm2) = arr3(row2, clm2)
                    Next
                    Exit For
                End If
            End If
        Next
    Next
    
    FindMatches_ = arrOut
End Function

Sub FindMatches(cntMtch&) 'cntMtch - заданное количество совпадений
    Dim arr1(), arr2(), arr3(), arrOut(), lr&
    
    lr = Columns("DV").Find("*", searchdirection:=xlPrevious).row
    arr2 = Range("DJ34:DS" & lr).Value   'где ищем
    arr1 = Range("BC34:BL" & lr).Value   'что ищем
    arr3 = Range("DY34:EI" & lr).Value   'откуда вытаскиваем строки
    
    arrOut = FindMatches_(arr1, arr2, arr3, cntMtch)
    
    Range("U34:AE34").Resize(UBound(arr1)).Value = arrOut 'куда выводим результат
End Sub

Sub FindMatches1()
    Const cntMtch& = 1 '1 - мин. количество совпадений
    Dim arr1(), arr2(), arr3(), arrOut(), lr&
    
    lr = Columns("DV").Find("*", searchdirection:=xlPrevious).row
    arr2 = Range("DJ34:DS" & lr).Value   'где ищем
    arr1 = Range("BC34:BL" & lr).Value   'что ищем
    arr3 = Range("DY34:EI" & lr).Value   'откуда вытаскиваем строки
    
    arrOut = FindMatches_(arr1, arr2, arr3, cntMtch)
    
    Range("U34:AE34").Resize(UBound(arr1)).Value = arrOut 'куда выводим результат
End Sub