[已解决]如何删除单元格中以逗号分隔的重复数据，相同的数据只保留一个？

arcticstar

如何删除单元格中以逗号分隔的重复数据，相同的数据只保留一个？效果如附件所示。不用考虑排序

最佳答案

月排行榜 / 总排行榜

grf1973

2015-10-29 16:25

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Range("b1:c" & [b65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         xrr = Split(arr(i, 1), ",")
   
6.         For k = 0 To UBound(xrr)
   
7.             d(xrr(k)) = ""
   
8.         Next
   
9.         arr(i, 2) = Join(d.keys, ",")
   
10.         d.RemoveAll
    
11.     Next
    
12.     [b1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
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.         xrr = Split(arr(i, 1), ",")
   
6.         For k = 0 To UBound(xrr)
   
7.             d(xrr(k)) = ""
   
8.         Next
   
9.         arr(i, 2) = Join(d.keys, ",")
   
10.         d.RemoveAll
    
11.     Next
    
12.     [a1].CurrentRegion = arr
    
13. End Sub
    

复制代码

grf1973

请看附件。

arcticstar

grf1973 发表于 2015-10-29 16:02
请看附件。

谢谢，请问如果原始数据放在第2列，结果放在第3列的话，代码应该怎么改？

grf1973

arr(i,1)改成arr(i,2)，arr(i,2)改成arr(i,3)

arcticstar

grf1973 发表于 2015-10-29 16:20
arr(i,1)改成arr(i,2)，arr(i,2)改成arr(i,3)

实测实际数据中有空行的情况，这个条件不能判断空行的情况，更正后的数据见附件，请再帮指教下。谢谢

金樽空对月

arcticstar 发表于 2015-10-29 16:07
谢谢，请问如果原始数据放在第2列，结果放在第3列的话，代码应该怎么改？

抱歉，回错帖了。

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Range("b1:c" & [b65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         xrr = Split(arr(i, 1), ",")
   
6.         For k = 0 To UBound(xrr)
   
7.             d(xrr(k)) = ""
   
8.         Next
   
9.         arr(i, 2) = Join(d.keys, ",")
   
10.         d.RemoveAll
    
11.     Next
    
12.     [b1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
13. End Sub
    

复制代码

arcticstar

grf1973 发表于 2015-10-29 16:25

谢谢，如果对删除重复数据后的C列新数据做排序处理，放在D列，应如何处理？
排序规则：按字母从a-z，数字0-9排序，字母优先，若C列数据与B列相同，则不进行排序（即仅排序有重复数据的单元格）。

grf1973

1. Sub tt()     '提取字符串中不重复值，并排序
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Range("b1:c" & [b65536].End(3).Row)
   
4.     For i = 2 To UBound(arr)
   
5.         xrr = Split(arr(i, 1), ",")
   
6.         For k = 0 To UBound(xrr)
   
7.             d(xrr(k)) = ""
   
8.         Next
   
9.         arr(i, 2) = Join(d.keys, ",")
   
10.         If arr(i, 1) <> arr(i, 2) Then
    
11.             [h1].Resize(d.Count, 1) = Application.Transpose(d.keys)
    
12.             [h1].Resize(d.Count, 1).Sort key1:=[h1]
    
13.             arr(i, 2) = Join(Application.Transpose([h1].Resize(d.Count, 1)), ",")
    
14.         End If
    
15.         d.RemoveAll
    
16.     Next
    
17.     [h:h].ClearContents
    
18.     [b1].Resize(UBound(arr), 2) = arr
    
19. End Sub
    

复制代码