[已解决]如何写代码,实现 自动填充,重复的去重复(新的附件和例子在30楼层)

studystudy

已经重新上传 附件了...

也 一一捉图了..

dsmch

1. Sub Macro1()
   
2. Dim arr, d, d2, i&, j&, x, y, w
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Set d2 = CreateObject("scripting.dictionary")
   
5. [b:b].ClearContents
   
6. arr = Range("g1").CurrentRegion
   
7. For j = 1 To UBound(arr, 2)
   
8.     For i = 2 To UBound(arr)
   
9.         x = Replace(arr(1, j), "对应", "")
   
10.         If arr(i, j) <> "" Then d(x) = d(x) & "," & arr(i, j)
    
11.     Next
    
12. Next
    
13. w = Split([a1])
    
14. For i = 0 To UBound(w)
    
15.     y = Split(d(w(i)), ",")
    
16.     For j = 1 To UBound(y)
    
17.         d2(y(j)) = ""
    
18.     Next
    
19. Next
    
20. Range("b1").Resize(d2.Count) = Application.Transpose(d2.keys)
    
21. End Sub
    

复制代码

dsmch

………………

爱疯

1）本帖的问题，是一个大问题中的小功能吗？

2）你的实际应用里，G列到U列不会被其它内容占用吗？也就说，可当作辅助区

3）A1的输入格式：某数+空格+某数+空格+... ，是吗？

studystudy

爱疯 发表于 2014-2-28 11:18
1）本帖的问题，是一个大问题中的小功能吗？

2）你的实际应用里，G列到U列不会被其它内容占用吗？也就说 ...

对....

不会占用...

格式 也如老师所说

爱疯

也许我的回复和32楼相似，你还是先回复32楼吧，如有疑问及时说明，这样才可能让更多的朋友来关注你的问题。

studystudy

32 33的测试...暂时没发现问题///