Excel合并同类项第四式：VBA

关于合并同类项的问题，前面我们讲了技巧、函数以及Power Query的处理方法，今天我们来讲讲如何利用"万能的"VBA来解决这个问题。

Sub Myjoin() 'by Excel小王子
 Dim arr, mrow As Integer, mcount As Integer, temparr(), mitem
 Set dic = CreateObject("Scripting.Dictionary")
 With Sheets("数据")
 arr = .[A1].CurrentRegion.Value
 Rem 将供应商装入字典，产品连接作为字典key对应的item
 For mrow = 1 To UBound(arr)
 dic(arr(mrow, 1)) = dic(arr(mrow, 1)) & "/" & arr(mrow, 2)
 Next
 ReDim temparr(1 To dic.Count, 1 To 1)
 mitem = dic.items
 Rem 将字典items写入临时数组并去掉最左边的分隔符"/"
 For mcount = 1 To dic.Count
 n = n + 1
 temparr(n, 1) = Mid$(mitem(n - 1), 2, Len(mitem(n - 1)) - 1)
 Next
 Rem 将供应商和对应的产品写回工作表相应位置
 .Range("D1").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
 .Range("E1").Resize(dic.Count, 1) = temparr
 End With
End Sub

将上述代码放出代码模块中，运行代码即可在"数据"工作表D1单元格处返回所有供应商和对应产品。动图效果演示如下：

如果数据源变动了，只需要重新运行一下代码即可得到更新后的结果，当然代码还需要做一些细节调整，比如先清除原有结果区域等，有兴趣的朋友可以做扩展练习去动手练练。

好了，今天的内容就是这些了，欢迎关注Excel小王子，Excel学习，E路有你。