我有这样的数据表:
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分钟或更长时间来计算 - 有时会导致工作表崩溃。
有人可以告诉我一个更好的方法吗?
答案 0 :(得分:3)
立即改进是将数据放入数组而不是引用每个检查的单元格:
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。
答案 1 :(得分:0)
我希望我的解决方案对你很有意思,在这里: 如果您按照正在使用的两列对数据进行排序,则它看起来像这样:
SupplierID Text
1 Foo
1 Bar
1 FooBar
2 Foo
2 Bar
2 FooBar
现在只需将此公式添加到Result
列:
=IF(A2<>A1,B2,CONCATENATE(C1,", ",B2))
这将创建如下输出:
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
最后,您可以在所有列中应用复制相同的文本。 我希望这有帮助!