[已解决]在A列查找与C列相同的值，并依次将对应的B列的值复制到C列后面

shiche12

在A列查找与C列相同的值，并依次将对应的B列的值复制到C列后面。附件里的我已经手动输入了几个，请教一个批量处理的公式或者VBA

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-3 14:52

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         If InStr(d(arr(i, 1)), arr(i, 2)) = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & arr(i, 2) & ","
   
6.     Next
   
7.     dk = d.keys
   
8.     [d2].Resize(d.Count, 1) = Application.Transpose(dk)
   
9.     For i = 0 To UBound(dk)
   
10.         xrr = Split(d(dk(i)), ",")
    
11.         Cells(i + 2, 5).Resize(1, UBound(xrr)) = xrr
    
12.     Next
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         If InStr(d(arr(i, 1)), arr(i, 2)) = 0 Then d(arr(i, 1)) = d(arr(i, 1)) & arr(i, 2) & ","
   
6.     Next
   
7.     dk = d.keys
   
8.     [d2].Resize(d.Count, 1) = Application.Transpose(dk)
   
9.     For i = 0 To UBound(dk)
   
10.         xrr = Split(d(dk(i)), ",")
    
11.         Cells(i + 2, 5).Resize(1, UBound(xrr)) = xrr
    
12.     Next
    
13. End Sub
    

复制代码

baksy

附件