Excel VBA中的自定义函数，该函数在返回多个匹配值并将其组合到一个单元格的范围内查找单元格值

Question

I'm trying to write a custom function in excel vba that lookup a cell value in a range that returns multiple match values and combine them in one cell. it returns an error in value #VALUE .

I'm trying to let the user use this function, as writing a sub to do that is working fine.

    Function LookUpMoreThanOneResult(LookUpFor As Range, LookUpAt As Range, col As Integer) As Range


Dim Findings As Range


For Each LookUpFor In LookUpFor.Cells

        For Each LookUpAt In LookUpAt.Cells

            If LookUpFor.Value = LookUpAt.Value Then

            Findings.Value = Findings.Value & vbCrLf & LookUpAt.Offset(0, col).Value
            End If


        Next LookUpAt

    Next LookUpFor

LookUpMoreThanOneResult = Findings

End Function

'below is the sub that works fine

Sub look()

Worksheets(1).Activate

Dim ref As Range

Dim arr As Range
Dim va As Range

Set ref = Range("j2:j7595")
Set arr = Worksheets(2).Range("d2:d371")

Dim r As Range
Dim a As Range


For Each r In ref.Cells

        For Each a In arr.Cells

            If r.Value = a.Value Then
            r.Offset(0, 11).Value = r.Offset(0, 11).Value & vbCrLf & a.Offset(0, 6).Value
            End If


        Next a

    Next r

End Sub

Answer 1

this is the answer, here i should not repeat the loop for the LookUpFor cell, and the return value of the function should be String. so it is owrking fine now, and the user can use it.

Function LookUpMoreThanOneResult(LookUpFor As Range, LookUpAt As Range, col As Integer) As String

Dim R As Range

        For Each R In LookUpAt

            If LookUpFor.Value = R.Value Then

            LookUpMoreThanOneResult = LookUpMoreThanOneResult & vbCrLf & R.Offset(0, col).Value
            End If

        Next R


End Function