Excel自定义函数实现一对多查找

这个问题很多人问过我，excel自带的函数组合也能够做到，但实际上效果一般都不理想，而且再次使用也很麻烦，所以自己写了个自定义函数。

这个自定义函数，是将所有符合条件的文本放在同一个单元格里，按给定的分隔符分隔。

Public Function Contxts(delimiter As String, ParamArray args() As Variant)
    Dim tmptext As Variant, i As Variant, Cellv As Variant
    Dim Cell As Range
    tmptext = ""
    For i = 0 To UBound(args)
        If Not IsMissing(args(i)) Then
            Select Case TypeName(args(i))
                Case "Range"
                    For Each Cell In args(i)
                        If Cell <> "" Then
                            tmptext = tmptext & Cell & delimiter
                        End If
                    Next Cell
                Case "Variant()"
                    For Each Cellv In args(i)
                        If Cellv <> "" Then
                            tmptext = tmptext & Cellv & delimiter
                        End If
                    Next Cellv
                Case Else
                    If args(i) <> "" Then
                        tmptext = tmptext & args(i) & delimiter
                    End If
            End Select
        End If
    Next i
    Contxts = Left(tmptext, Len(tmptext) - 1)
End Function

函数实际上就是利用if得到数组，并把所有的数组用分隔符重新组合，下图就是使用函数的一个例子。

这样的结果里没有排除重复值，所以我又写了一个函数，以应对这种情况。

Public Function Duplicates(s As String, delimiter As String)
    Dim qt() As String, str As String
    Dim n As Long
    qt = Split(s, delimiter)
    str = qt(0) & ","
    For n = 1 To UBound(qt)
        If InStr(1, str, qt(n)) = 0 Then
            str = str & qt(n) & ","
        End If
    Next n
    Duplicates = Left(str, Len(str) - 1)
End Function

这个函数对任何一个有固定分隔符的字符串，都能进行去重，并重新组合。