[已解决]重复号码的提取

dulian168

各位  老师       麻烦帮我提取下重复号码   



详细 在附件


谢谢

最佳答案

月排行榜 / 总排行榜

26759761@qq.com

2015-3-31 02:24

1. Function cf(rg As Range, tj As Integer) '1 代表重复,2代表替换
   
2. '=cf(单元格,1)   =cf(单元格,2)
   
3. Dim x, d, s, st, st1
   
4. Set d = CreateObject("scripting.dictionary")
   
5. st1 = rg
   
6.     For x = 1 To Len(rg)
   
7.       st = Mid(rg, x, 1)
   
8.         If d.exists(st) Then
   
9.             st1 = Replace(st1, st, "")
   
10.             If InStr(s, st) = 0 Then s = s & st
    
11.          Else
    
12.             d(st) = ""
    
13.         End If
    
14.     Next
    
15. cf = IIf(tj = 1, s & "", IIf(tj = 2, st1, ""))
    
16. End Function
    

复制代码

跳转到最佳答案楼层

26759761@qq.com

自定义函数行不行

dulian168

26759761@qq.com 发表于 2015-3-30 22:07
自定义函数行不行

只要是能复制的  就可以

26759761@qq.com

1. Function cf(rg As Range, tj As Integer) '1 代表重复,2代表替换
   
2. '=cf(单元格,1)   =cf(单元格,2)
   
3. Dim x, d, s, st, st1
   
4. Set d = CreateObject("scripting.dictionary")
   
5. st1 = rg
   
6.     For x = 1 To Len(rg)
   
7.       st = Mid(rg, x, 1)
   
8.         If d.exists(st) Then
   
9.             st1 = Replace(st1, st, "")
   
10.             If InStr(s, st) = 0 Then s = s & st
    
11.          Else
    
12.             d(st) = ""
    
13.         End If
    
14.     Next
    
15. cf = IIf(tj = 1, s & "", IIf(tj = 2, st1, ""))
    
16. End Function
    

复制代码