[已解决]请教：数据去重复降序排列的宏

海水鱼

请看：附件，谢谢

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-14 15:50

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For j = 4 To 7
   
4.         arr = Range(Cells(10, j), Cells(65536, j).End(3))
   
5.         For Each x In arr
   
6.             d(x) = ""
   
7.         Next
   
8.         Cells(10, j + 5).Resize(d.Count, 1) = Application.Transpose(d.keys)
   
9.         Cells(10, j + 5).Resize(d.Count, 1).Sort key1:=Cells(10, j + 5), order1:=xlDescending
   
10.         d.RemoveAll
    
11.     Next
    
12. End Sub

复制代码

跳转到最佳答案楼层

sry660

1. Sub 删除重复后排序()
   
2. Application.ScreenUpdating = False
   
3. Application.DisplayAlerts = False
   
4. Dim i%
   
5. [d10].CurrentRegion.Copy [o10]
   
6. For i = 15 To 18
   
7.     With Range(Cells(10, i), Cells(21, i))
   
8.         .RemoveDuplicates Columns:=1, Header:=xlNo
   
9.         .Sort Key1:=Cells(10, i), Order1:=xlDescending
   
10.     End With
    
11. Next
    
12. Application.DisplayAlerts = True
    
13. Application.ScreenUpdating = True
    
14. End Sub

复制代码

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     For j = 4 To 7
   
4.         arr = Range(Cells(10, j), Cells(65536, j).End(3))
   
5.         For Each x In arr
   
6.             d(x) = ""
   
7.         Next
   
8.         Cells(10, j + 5).Resize(d.Count, 1) = Application.Transpose(d.keys)
   
9.         Cells(10, j + 5).Resize(d.Count, 1).Sort key1:=Cells(10, j + 5), order1:=xlDescending
   
10.         d.RemoveAll
    
11.     Next
    
12. End Sub

复制代码

金樽空对月

见附件，内详。