在逗号分隔的列表中列出所有匹配的值？答案

【问题标题】：List all matching values in a comma separated list?在逗号分隔的列表中列出所有匹配的值？
【发布时间】：2017-07-31 01:18:21
【问题描述】：

我有 2 个工作表：

工作表 1：

Column C            Column D
Supplier A          Fish
Supplier A          Meat
Supplier B          Bread

工作表 2：

Column C            Column F
Supplier A
Supplier B

在 F 列中，我想创建一个与供应商匹配的所有项目的列表。

例如：

Column C         Column F  
Supplier A       Fish, Meat
Supplier B       Bread

我正在使用以下 vba 函数：

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

F列中的这个公式

=SingleCellExtract(C1,Data!D:D,-1,",")

实际代码工作正常，但我想消除将公式“拖”到 F 列以生成结果的需要。有没有一种方法可以改进代码以绕过对公式的需求，只需要：

Range F1 = 'Comma Separated List'
Next Cell in column F
etc...

【问题讨论】：

您需要创建一个子程序，在子程序遍历 F 列时调用该函数。

标签： vba excel

【解决方案1】：

您可以使用宏并利用 Dictionary 对象

Sub Main()
    Dim cell As Range

    With CreateObject("Scripting.Dictionary")
        For Each cell In Worksheets("Sheet1").Range("C1", Worksheets("Sheet1").Cells(Rows.count, "C").End(xlUp))
            .item(cell.Value) = .item(cell.Value) & cell.Offset(, 1).Value & ","
        Next
        For Each cell In Worksheets("Sheet2").Range("C1", Worksheets("Sheet2").Cells(Rows.count, "C").End(xlUp))
            MsgBox .item(cell.Value)
            cell.Offset(, 3).Value = Left(.item(cell.Value), Len(.item(cell.Value)) - 1)
        Next
    End With
End Sub

【讨论】：