Excel:查找所有匹配的值,并用逗号分隔列表吗?

我有这样的数据表:

Col A Col B Col C Column D Col E Column F Col G Col H Col I Col J Col K 1234 Supplier 1 2222 Supplier 2 3333 Supplier 2 4444 Supplier 1 

我也有另一张纸

 Home sheet: Column B Supplier 1 <-- Values Produced From Index Match Formula Supplier 2 

我想列出D列数据表中所有与主页上的供应商名称相匹配的项目编号。

但是,我想把所有匹配的项目号码放在一个单元格中,用逗号分隔的列表如下所示:

 Home sheet: Column B Column C Supplier 1 1234, 4444 Supplier 2 2222, 3333 

目前我正在使用vba中的用户定义函数来做这件事:

 Function SingleCellExtract(LookupValue As String, LookupRange As Range, ColumnNumber As Integer, Char As String) 'Updateby20150824 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(B14,Data!F:F,-1,",") 

然而,这样做有效,但是我有超过500行的数据,而且这种方法需要大约10分钟甚至更多的时间来计算 – 有时会导致表单崩溃。

请有人给我看一个更好的方法来做到这一点?

立即改进是将数据放入一个数组,而不是引用每个检查的单元格:

 Function SingleCellExtract(LookupValue As String, LookupRange As Range, LookupCol As Long, ReturnCol As Long, Char As String) 'Updateby20150824 Dim varTMP As Variant, I As Long varTMP = LookupRange Dim xRet As String For I = 1 To UBound(varTMP, 1) If varTMP(I, LookupCol) = LookupValue Then If xRet = "" Then xRet = varTMP(I, ReturnCol) Else xRet = xRet & Char & varTMP(I, ReturnCol) End If End If Next SingleCellExtract = xRet End Function 

我还修改了你的return行和xRet逻辑,以避免需要left / len。

我希望我的解决scheme对你来说很有意思,在这里它是这样的:如果你正在使用两列对数据进行sorting,它将看起来像这样:

 SupplierID Text 1 Foo 1 Bar 1 FooBar 2 Foo 2 Bar 2 FooBar 

现在只需将此公式添加到“ Result列中:

 =IF(A2<>A1,B2,CONCATENATE(C1,", ",B2)) 

这将创build像这样的输出:

 SupplierID Text Result 1 Foo Foo 1 Bar Foo, Bar 1 FooBar Foo, Bar, FooBar 2 Foo Foo 2 Bar Foo, Bar 2 FooBar Foo, Bar, FooBar 

最后,你可以申请复制所有列中的相同文本。 我希望这有帮助!