|
送人玫瑰，手有余香，请将文章分享给更多朋友
动手操作是熟练掌握EXCEL的最快捷途径！ 【置顶公众号】或者【设为星标】及时接收更新不迷路 小伙伴们好，今天来和大家分享一则VBA字典的题目。其实这个类型的题目经常会遇到，并且如果你可以使用高版本函数，那可以很好的解决这个问题。 今天则用一段代码来处理这个题目。原题是这样的： 题目要求按照类别来汇总左侧的数据。结果如右侧。 完整代码如下： Sub 合并同类项() Dim i As Integer, myarr As Variant, mydic As Object, brr(), d, r Set mydic = CreateObject("scripting.dictionary") myarr = Range("A1").CurrentRegion For i = 1 To UBound(myarr) If mydic.exists(myarr(i, 1) & "-" & myarr(i, 3)) Then mydic(myarr(i, 1) & "-" & myarr(i, 3)) = _ mydic(myarr(i, 1) & "-" & myarr(i, 3)) & "、" & myarr(i, 2) Else mydic(myarr(i, 1) & "-" & myarr(i, 3)) = myarr(i, 2) End If Next i ReDim brr(1 To mydic.Count, 1 To UBound(myarr, 2)) For Each d In mydic.keys r = r + 1 brr(r, 1) = Split(d, "-")(0) brr(r, 2) = mydic(d) brr(r, 3) = Split(d, "-")(1) Next [E10].Resize(UBound(brr), 3) = brrEnd Sub
其中： For i = 1 To UBound(myarr) If mydic.exists(myarr(i, 1) & "-" & myarr(i, 3)) Then mydic(myarr(i, 1) & "-" & myarr(i, 3)) = _ mydic(myarr(i, 1) & "-" & myarr(i, 3)) & "、" & myarr(i, 2) Else mydic(myarr(i, 1) & "-" & myarr(i, 3)) = myarr(i, 2) End IfNext i
第5-12行代码：创建字典。将源数据第1列和第3列组合后作为键，并通过循环不断进行同类项值的合并。 注意，这里使用了IF语句，当键不在字典中时，创建后首先要对其赋值，然后再在此基础上循环合并同类的数据。如果不这样，就要添加On Error语句。 ReDim brr(1 To mydic.Count, 1 To UBound(myarr, 2))
第13行代码，重新定义动态数组brr For Each d In mydic.keys r = r + 1 brr(r, 1) = Split(d, "-")(0) brr(r, 2) = mydic(d) brr(r, 3) = Split(d, "-")(1)Next
第14-19行代码：再次通过For Each语句循环将键拆分后复制给动态数组brr
好了朋友们，今天和大家分享的内容就是这些了！喜欢我的文章请分享、转发、点赞和收藏吧！如有任何问题可以随时私信我哦！-END-
|
