[已解决]按某列内的条件排名

安全网 · 发表于 2015-11-19 17:23

本帖最后由安全网于 2015-11-20 16:48 编辑

求助增加按照C内的条件排名，排名的数据写入汇总排名后面的VBA代码，具体见附件

最佳答案

grf1973

2015-11-20 16:22

请看附件。

安全网 · 发表于 2015-11-19 17:23

附件已上传

安全网 · 发表于 2015-11-20 08:49

就是区域内排名，全部排名，请问有高手知道怎么修改VBA代码吗

grf1973 · 发表于 2015-11-20 11:35

跟那个成绩排名不是一样的吗？不会改改？

grf1973 · 发表于 2015-11-20 13:36

Sub 排名()
Dim Bigrng As Range, MyCell As Range
Dim Flag As Boolean '判断有否汇总列
If Not ActiveSheet.[b:b].Find("汇总") Is Nothing Then Flag = True '有汇总，Flag为true
Set d = CreateObject("scripting.dictionary")
[p3:q65536].ClearContents
arr = [a1].CurrentRegion
rmax = IIf(Flag, UBound(arr) - 1, UBound(arr)) '最大行，根据有无汇总不同
Set MyCell = Application.InputBox(prompt:="请选择需要排名的列（点击标题栏）", Type:=8)
If MyCell.Columns.Count > 1 Then MsgBox "只能选择单列！": Exit Sub
c = MyCell.Column: bt = Cells(2, c) '标题
If InStr(bt, "月") = 0 And bt <> "汇总" Then MsgBox "请选择月份或汇总列！": Exit Sub
Range("d3").Resize(rmax - 2, UBound(arr, 2) - 5).SpecialCells(xlCellTypeBlanks) = 0 '所有空格标上0，不然排名出错
Set Bigrng = Range(Cells(3, c), Cells(rmax, c)) '数据所在列的所有区域（全排名）
For i = 3 To rmax '数据所在列的特定区域（区域排名）
qy = arr(i, 3) '区域
If Not d.exists(qy) Then Set d(qy) = Cells(i, c) Else Set d(qy) = Union(d(qy), Cells(i, c))
Next
ReDim brr(1 To rmax, 1 To 2) '保存排名结果
For i = 3 To rmax
qy = arr(i, 3)
brr(i, 1) = Application.WorksheetFunction.Rank(Val(arr(i, c)), Bigrng) '全排名
If d.exists(qy) Then brr(i, 2) = Application.WorksheetFunction.Rank(Val(arr(i, c)), d(qy)) '区域排名
Next
[a1].CurrentRegion = arr
brr(2, 1) = bt & "总排名"
brr(2, 2) = bt & "区域排名"
[p1].Resize(rmax, 2) = brr
End Sub

复制代码

安全网 · 发表于 2015-11-20 13:55

grf1973 发表于 2015-11-20 13:36

排名的数据可否选择写入不同的列内

grf1973 · 发表于 2015-11-20 16:22

请看附件。

安全网 · 发表于 2015-11-21 16:48

grf1973 发表于 2015-11-20 16:22
请看附件。

如果不选择单元格标题栏，点击取消就会运行出错，这个怎么解决

grf1973 · 发表于 2015-11-23 10:50

貌似解决不了。

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