VBA函数返回所有唯一的匹配值

我一直在寻找一种解决方案，允许Excel用户输入一个类似于vlookup的公式，将所有唯一的匹配值返回到单个单元格

我写了下面的代码，似乎可以工作，但我正在尝试在2000多个单元格中运行该函数，它在我的Thinkstation-S30上运行得非常慢，我担心它会使任何试图从较慢的机器上打开该文件的人崩溃。有人对如何使该功能更有效有任何想法吗？很抱歉代码太草率了，我是一名会计

Public Function MvalLookup(Lookup_vector As Range, Result_vector As Range,_
Criteria As Variant, Seperator As String)
'
' Returns a list of all unique values matching the criteria
'

Dim arr As New Collection, a
Dim i As Integer
Dim j As Integer
Dim z As Integer
Dim result As String
Dim lookuprange As Integer

z = Lookup_vector.Rows.Count
j = 0
On Error Resume Next
For lookuprange = 1 To z
'determine how many values match- determine the required array size
If CStr(Lookup_vector(lookuprange, 1)) = CStr(Criteria) Then
    arr.Add CStr(Result_vector(lookuprange, 1)), CStr(Result_vector(lookuprange, 1))
    j = j + 1
End If
Next lookuprange

' Write results

result = arr(1)
If arr.Count <= 1 Then GoTo Output
For i = 2 To arr.Count
     result = result & Seperator & arr(i)
Next

Output:
'Output results
MvalLookup = result

End Function

公共函数MvalLookup（查找向量作为范围，结果向量作为范围_
标准作为变量，分隔符作为字符串）
'
'返回与条件匹配的所有唯一值的列表
'
Dim arr作为新系列，a
作为整数的Dim i
作为整数的Dim j
将z调整为整数
将结果变暗为字符串
Dim lookuprange作为整数
z=查找_vector.Rows.Count
j=0
出错时继续下一步
对于lookuprange=1到z
'确定匹配的值数-确定所需的数组大小
如果CStr（查找向量（查找范围，1））=CStr（标准），则
加上CStr（结果向量（lookuprange，1）），CStr（结果向量（lookuprange，1））
j=j+1
如果结束
下一个查找范围
"写结果"
结果=arr（1）
如果arr.Count感谢Ralph的链接，那篇文章中的建议真的很有帮助。只需将范围存储为数组，即可缩短近10秒的处理时间

修订后的守则如下：

Public Function MvalLookup(Lookup_vector As Range, Result_vector As Range,_
Criteria As Variant, Seperator As String)
'
' MValLookup Macro
' Returns a list of all unique values matching the criteria
'

Dim arr As New Collection, a
Dim i As Integer
Dim j As Integer
Dim z As Integer
Dim result As String
Dim lookuprange As Integer
Dim LUVect As Variant
Dim RESVect As Variant

z = Lookup_vector.Rows.Count
j = 0
LUVect = Lookup_vector.Value2
RESVect = Result_vector.Value2
On Error Resume Next
For lookuprange = 1 To z
'determine how many values match- determine the required array size
If CStr(LUVect(lookuprange, 1)) = CStr(Criteria) Then
    arr.Add CStr(RESVect(lookuprange, 1)), CStr(RESVect(lookuprange, 1))
    j = j + 1
End If
Next lookuprange

' Write results

result = arr(1)
If arr.Count <= 1 Then GoTo Output
For i = 2 To arr.Count
     result = result & Seperator & arr(i)
Next

Output:
'Output results
MvalLookup = result

End Function

公共函数MvalLookup（查找向量作为范围，结果向量作为范围_
标准作为变量，分隔符作为字符串）
'
'MValLookup宏
'返回与条件匹配的所有唯一值的列表
'
Dim arr作为新系列，a
作为整数的Dim i
作为整数的Dim j
将z调整为整数
将结果变暗为字符串
Dim lookuprange作为整数
Dim LUVect作为变体
Dim RESVect作为变体
z=查找_vector.Rows.Count
j=0
LUVect=Lookup\u vector.Value2
RESVect=Result\u vector.Value2
出错时继续下一步
对于lookuprange=1到z
'确定匹配的值数-确定所需的数组大小
如果CStr（LUVect（lookuprange，1））=CStr（标准），则
对应添加CStr（RESVect（lookuprange，1）），CStr（RESVect（lookuprange，1））
j=j+1
如果结束
下一个查找范围
"写结果"
结果=arr（1）
如果算一下，它的运行速度有多慢？我不确定使用集合和阵列之间的速度差异，但这可能会提高您的速度。您可能希望阅读这篇文章和以下4篇关于编写快速高效的UDF的文章：在我的PC上使用2.6ghz处理器运行大约需要30-45秒。我会把它改成一个数组，谢谢！对于代码审查来说，这是一个很好的问题！（）您应该将i、j、z更改为
Long