[已解决]如何在表中选择指定目标最大前三名？

lsy1133

如何在表中选择指定目标最大前三名？见附件，谢谢老师！

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-3 04:49

1. Sub Macro1()
   
2. Dim arr, d, i&, zf
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b3").CurrentRegion
   
5. zf = "项目2"
   
6. For i = 1 To UBound(arr)
   
7.     If arr(i, 1) = zf Then d(i) = arr(i, 2)
   
8. Next
   
9. For j = 1 To 3 '前三
   
10.     Cells(j + 6, "f") = zf
    
11.     Cells(j + 6, "g") = Application.Large(d.items, j)
    
12. Next
    
13. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&, zf
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b3").CurrentRegion
   
5. zf = "项目2"
   
6. For i = 1 To UBound(arr)
   
7.     If arr(i, 1) = zf Then d(i) = arr(i, 2)
   
8. Next
   
9. For j = 1 To 3 '前三
   
10.     Cells(j + 6, "f") = zf
    
11.     Cells(j + 6, "g") = Application.Large(d.items, j)
    
12. Next
    
13. End Sub

复制代码

baksy

附件

ppp710715

第二名应该是     项目6         297,608.21

1. Sub 排前三()
   
2. Dim arr, d, i&,j,k
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("b3").CurrentRegion
   
5. For i = 1 To UBound(arr)
   
6.     d(arr(i, 2)) = arr(i, 1)
   
7. Next
   
8. For j = 1 To 3 '排前三
   
9.     k = Application.Large(d.keys, j)
   
10.     Cells(j + 6, "g") = k
    
11.     Cells(j + 6, "f") = d(k)
    
12. Next
    
13. End Sub

复制代码

wyshun

baksy 发表于 2015-3-3 06:15
附件

这个好！学习了！！！

lsy1133

dsmch 发表于 2015-3-3 04:49

OK，在大量数据中选择速度很快，谢谢你！其他回答也都能实现，我把最佳答案给最先回答的老师。