用于在 vlookup 中连接多个匹配项的 UDF 问题

Question

For the life of me, I can't figure out why this isn't working. It gives me a #VALUE error.

I'm using ActiveSheet because I'll put it on a number of different sheets, and I don't want to have to add a field in the function for that.

LookupRange is designed to find the last row with data in it on ActiveSheet.

My lookup values begin in B5 and extend indefinitely, and the desired matches are in Column O (15th column).

Function EmailConcat(LookupValue As String)

Application.Volatile

Dim i As Long
Dim Result As String
Dim LookupSheet As Worksheet
Dim LookupRange As Range

Set LookupSheet = Application.ActiveSheet

LookupRange = LookupSheet.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row

For i = 5 To LookupRange.Rows.Count
    If LookupSheet.Cells(i, 2) = LookupValue Then

    Result = Result & LookupSheet.Cells(i, 15) & "; "

    End If
Next i

EmailConcat = Left(Result, Len(Result) - 2)

End Function

Answer 1

Using ThisCell to ensure results are accurate, and reading the lookup column into an array for better performance:

Function EmailConcat(LookupValue As String)

    Application.Volatile

    Dim vals, rv, i As Long, sep As String

    If LookupValue <> "" Then
        With Application.ThisCell.Worksheet
            vals = .Range(.Range("B5"), .Cells(.Rows.Count, 2).End(xlUp))
            For i = 1 To UBound(vals, 1)
                If vals(i, 1) = LookupValue Then
                    rv = rv & sep & .Cells(4 + i, 15).Value
                    sep = "; "
                End If
            Next i
        End With
    End If
    EmailConcat = rv

End Function

Answer 2

Concatenate Multiple

When using Range or Cells etc. without qualifiers, they refer to the ActiveSheet of the ActiveWorkbook .

The Code

Function EmailConcat(LookupValue As String)

    Application.Volatile

    Const cFirst As String = "B5"
    Const cCol As Variant = "O"
    Dim i As Long
    Dim Result As String
    Dim LastRow As Long

    LastRow = Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious).Row

    For i = Range(cFirst).Row To LastRow
        If Cells(i, Range(cFirst).Column) = LookupValue Then
            Result = Result & Cells(i, cCol) & "; "
        End If
    Next i

    EmailConcat = Left(Result, Len(Result) - 2)

End Function