Получить значение из одной строки в указанном столбце

Question

Я пытаюсь определить функцию Excel в VBA, где я могу указать Apple или Orange, как в =MyFunc("Apple"), и получить обратно «Том» или «Дик, Гарри». Я могу выяснить, какой Row ищет поисковый запрос, используя Find, но я не могу понять, как сканировать часть этого строки для «X» (или не пусто) и возвращать значения из верхней строки соответствующий «X».

... B ... M  N ... CR 
    ___________________________________ 
3 |  | Tom | Dick | Harry 
    +--------+-------+--------+-------- 
4 | Apple | X |  | 
    +--------+-------+--------+-------- 
5 | Orange |  | X | X 

То, что я получил до сих пор:

Function MyFunc(what As String, Optional sep As String = ", ") As String 
Dim rngSearch As Range, rngFound As Range 
Dim strResult As String, allNames As Range 
Set rngSearch = Worksheets("Sheet1").Range("B:B") 
Set allNames = Worksheets("Sheet1").Range("M3:CR3") 
Set rngFound = rngSearch.Find(what, LookIn:=xlValues, LookAt:=xlPart) 
If rngFound Is Nothing Then 
    MsgBox "Not found" 
Else 
    MsgBox rngFound.Row 
    'search that row from Col M to Col CR for "X", add value in Row 3 to strResult if X is found 
End If 
MyFunc = strResult 
End Function 

Answer 1

Это будет делать то, что вы хотите.

Я использовал массивы для ускорения процесса.

Function MyFunc(what As String, Optional sep As String = ", ") As String 
Dim nmerng() As Variant 
Dim xrng() As Variant 
Dim rw As Variant 
Dim ws As Worksheet 
Dim i& 

Set ws = ActiveSheet 
With ws 
    'load the names in an array 
    nmerng = .Range("M3:CR3").Value 
    'find correct row to check 
    rw = Application.Match(what, .Range("B:B"), 0) 
    'If value is not found then rw will be an error 
    If IsError(rw) Then 
     MyFunc = "Not Found" 
     Exit Function 
    End If 
    'load row to check in array 
    xrng = .Range("M" & rw & ":CR" & rw).Value 
    'cycle through array finding all the "X" 
    For i = LBound(xrng, 2) To UBound(xrng, 2) 
     If xrng(1, i) = "X" Then 
      'Concatenate the names where there is an "X" 
      MyFunc = MyFunc & nmerng(1, i) & sep 
     End If 
    Next i 
    'Remove the last two characters of extra sep 
    MyFunc = Left(MyFunc, Len(MyFunc) - Len(sep)) 
End With 

End Function