[已解决]关于提取重复数字的问题

Gy奔跑吧小不点

这个附件是剔除重复数后再进行提取。怎么改成只提取重复的数。例子见附件。请求老师帮忙修改，谢谢

最佳答案

月排行榜 / 总排行榜

dsmch

2016-11-13 10:00

1. Sub Macro1()
   
2. Dim arr, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.     n = 26
   
7.     For j = 1 To UBound(arr, 2)
   
8.         d(arr(i, j)) = d(arr(i, j)) + 1
   
9.     Next
   
10.     For Each a In d.keys
    
11.         If d(a) > 1 Then n = n + 1: Cells(i, n) = a
    
12.     Next
    
13.     d.RemoveAll
    
14. Next
    
15. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("a1").CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.     n = 26
   
7.     For j = 1 To UBound(arr, 2)
   
8.         d(arr(i, j)) = d(arr(i, j)) + 1
   
9.     Next
   
10.     For Each a In d.keys
    
11.         If d(a) > 1 Then n = n + 1: Cells(i, n) = a
    
12.     Next
    
13.     d.RemoveAll
    
14. Next
    
15. End Sub

复制代码

Gy奔跑吧小不点

dsmch 发表于 2016-11-13 10:00

非常给力，谢谢老师