[已解决]VBA用两种方法提取前十名到DE列

laoau138 · 发表于 2017-10-31 14:29

本帖最后由 laoau138 于 2017-10-31 18:01 编辑

VBA用两种方法提取前十名到DE列

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-10-31 17:07

不考虑重复数。

Sub aaa()
Dim arr, brr(1 To 10, 1 To 1), i&, j&, mx#, tmp#
arr = [a1].CurrentRegion
For j = 1 To 10
For i = 2 To UBound(arr)
If arr(i, 1) = tmp Then
arr(i, 1) = 0
Else
If mx < arr(i, 1) Then mx = arr(i, 1)
End If
Next i
brr(j, 1) = mx
tmp = mx
mx = 0
Next j
[e2].Resize(10) = brr
End Sub

复制代码

跳转到最佳答案楼层

yanhj · 发表于 2017-10-31 15:22

Private Sub CommandButton1_Click()
For i = 1 To 10
Cells(i + 1, 5) = Application.WorksheetFunction.Large(Range("A2:A" & [A65536].End(3).Row), i)
Next
End Sub
可以用简单的方法吗？

yanhj · 发表于 2017-10-31 15:36

=LARGE(A$2:A$37,ROW(A1)) 下拉。

laoau138 · 发表于 2017-10-31 16:29

yanhj 发表于 2017-10-31 15:22
Private Sub CommandButton1_Click()
For i = 1 To 10
Cells(i + 1, 5) = Application.WorksheetFunct ...

还有数组方法没有写

大灰狼1976 · 发表于 2017-10-31 17:07

这个最佳答案由大灰狼1976 给出，感谢大灰狼1976 的回答。

单击隐藏图章

不考虑重复数。

Sub aaa()
Dim arr, brr(1 To 10, 1 To 1), i&, j&, mx#, tmp#
arr = [a1].CurrentRegion
For j = 1 To 10
For i = 2 To UBound(arr)
If arr(i, 1) = tmp Then
arr(i, 1) = 0
Else
If mx < arr(i, 1) Then mx = arr(i, 1)
End If
Next i
brr(j, 1) = mx
tmp = mx
mx = 0
Next j
[e2].Resize(10) = brr
End Sub

复制代码

laoau138 · 发表于 2017-11-1 08:29

大灰狼1976 发表于 2017-10-31 17:07
不考虑重复数。

用VBA数组第二种方法填充绿色

http://www.excelpx.com/thread-434739-1-1.html

yanhj · 发表于 2017-11-3 08:42

考虑重复该如何做？

laoau138 · 发表于 2017-11-11 09:33

大灰狼1976 发表于 2017-10-31 17:07
不考虑重复数。

VBA实现找零钱方案用inputbox写成通用版

http://www.excelpx.com/thread-435026-1-1.html

		自动登录	找回密码
密码			注册

[已解决]VBA用两种方法提取前十名到DE列

评分

评分

评分