Wert aus dem einzeiligen Bereich in der angegebenen Spalte

Question

Ich versuche, eine Excel-Funktion in VBA zu definieren, wo ich Apple oder Orange wie in =MyFunc("Apple") angeben kann und erhalten "Tom" oder "Dick, Harry". Ich bin in der Lage, herauszufinden, in welcher Zeile die Suchabfrage mit Find ist, aber ich kann nicht herausfinden, wie man einen Teil dieser Zeile nach "X" scannt (oder nicht leer) und den Wert (die Werte) von der obersten Zeile zurückgibt entsprechend dem "X".

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

Was ich bisher habe:

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

Dies wird tun, was Sie wollen.

Ich habe Arrays verwendet, um den Prozess zu beschleunigen.

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