VBA 代码 VLookup 多个条件并删除重复项答案

【问题标题】：VBA Code to VLookup Multiple Criteria & Remove DuplicatesVBA 代码 VLookup 多个条件并删除重复项
【发布时间】：2018-05-29 23:10:13
【问题描述】：

我有一个 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

【问题讨论】：

你能显示一点数据并解释一下吗？不确定我是否理解。

标签： excel vba vlookup

【解决方案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

【讨论】：