从指定列

Question

我试图在VBA中定义Excel功能，我可以在=MyFunc("Apple")中指定Apple或Orange并返回＆＃34; Tom＆＃34;或者＆＃34; Dick，Harry＆＃34;。我能够使用Find找出搜索查询所在的行，但我无法弄清楚如何扫描部分行以及＃34; X＆＃34; （或不为空）并返回与＆＃34; X＆＃34;对应的顶行的值。

  ...  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