Excel:查找所有匹配值并将其放入逗号分隔列表中？

Question

我有一个像这样的数据表:

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 分钟或更长时间来计算 - 有时会导致工作表崩溃。

请问有人可以告诉我更好的方法吗？

Answer 1

直接的改进是将数据放入数组中，而不是在每次检查时引用单元格:

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

我还修改了您的返回行和 xRet 逻辑，以避免需要 left/len。