VBA代码到VLookup多标准＆amp;删除重复项

Question

我有一个VBA代码，在给定一组条件的情况下为特定输入返回多个值 - 如果彼此不唯一，我如何更改代码以使其返回多个值？

Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
    Dim I As Long
    Dim xRet As String
    For I = 1 To LookupRange.Columns(1).Cells.Count
        If LookupRange.Cells(I, 1) = LookupValue Then
            If xRet = "" Then
                xRet = LookupRange.Cells(I, ColumnNumber) & Char
            Else
                xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
            End If
        End If
    Next
    SingleCellExtract = Left(xRet, Len(xRet) - 1)
End Function

单元格中的公式：

=SingleCellExtract(Lookup Cell,Lookup Range,Column Index Number," & ")

enter image description here

在上面的示例中，没有重复值 - 但是在我的数据中，多个名称出现在同一个日期，因此我最终得到以下内容。我怎么才能让它只返回一个名字，除非它们彼此独特？

enter image description here

Answer 1

向IF添加支票以确保它不存在：

Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String)
    Dim I As Long
    Dim xRet As String
    For I = 1 To LookupRange.Columns(1).Cells.Count
        If LookupRange.Cells(I, 1) = LookupValue And InStr(Char & xRet, Char & LookupRange.Cells(I, ColumnNumber) & Char) = 0 Then
            If xRet = "" Then
                xRet = LookupRange.Cells(I, ColumnNumber) & Char
            Else
                xRet = xRet & "" & LookupRange.Cells(I, ColumnNumber) & Char
            End If

        End If
    Next
    SingleCellExtract = Left(xRet, Len(xRet) - len(char))
End Function