无论是学校的老师,还是从做销售管理,经常要做同一个工作:制作排行榜
很多人都是手工排序,然后手工添加名次:
麻烦在于名次要一个个的输入,因为有分数相同的,如果向下拖动复制容易出错。用rank函数也无法处理相同分数的问题。
除了语文,还有数学、化学等排名榜都需要你手工制作。下次数据更新后,还要手工操作一遍。
是不是很麻烦?是!
为了解决排行榜难题,小编编了一个自定义函数,可以实现自动生成排行榜。无论数据怎么变,排名榜都可以自动更新。
下面,只需要1分钟,你也可以生成自动更新的排名榜。
操作步骤 :
1、复制下面代码
'示例用代码
Function PaiMing(rg As Range, rg1 As Range) Dim iOuter As Long Dim iInner As Long Dim iLBound As Long Dim iUBound As Long Dim iTemp As Double Dim x As Long, k As Long Dim arr1, arr2, arr3(1 To 10000, 1 To 3) arr1 = rg arr2 = rg1 If UBound(arr1, 2) > 1 Then arr1 = Application.Transpose(arr1) arr2 = Application.Transpose(arr2) End If iLBound = LBound(arr1) iUBound = UBound(arr1) '冒泡排序 For iOuter = iLBound To iUBound For iInner = iLBound To iUBound - iOuter '比较相邻项 If arr1(iInner, 1) < arr1(iInner + 1, 1) Then '交换值 iTemp = arr1(iInner, 1) iTemp1 = arr2(iInner, 1) arr1(iInner, 1) = arr1(iInner + 1, 1) arr1(iInner + 1, 1) = iTemp arr2(iInner, 1) = arr2(iInner + 1, 1) arr2(iInner + 1, 1) = iTemp1 End If Next iInner Next iOuter For x = 1 To UBound(arr1) arr3(x, 1) = arr2(x, 1) arr3(x, 2) = arr1(x, 1) k = k + 1 If x > 1 Then If arr1(x, 1) = arr1(x - 1, 1) Then k = k - 1 End If arr3(x, 3) = k Next x PaiMing = arr3 End Function
2、粘贴代码
工作表标签右键 - 查看代码 - 在新打开的VBE窗口插入模块 - 把代码粘贴到右侧的窗口中,然后关闭窗口。
3、保存文件
当前文件另存为“Excel 启用宏的工作簿”
设置完成后,就可以使用排名函数了。
1、用法介绍
=PaiMing(数据区域,对应排名指标)
语法说明:
- 数据区域:要排名的数据区域,可以是一列区域,也可以是一行区域。
- 对应排名指标:和数据一一对应的指标。
2、设置方法
以生成语文排名为例,选取i3:k8区域(根据排行榜需要选取行数),在编辑栏中输入公式
=PaiMing(B2:B15,A2:A15)
然后按Ctrl+Shift+Enter三键完成输入(输入后公式两边会添加大括号{})
注:生成排行也可以用一般的函数公式,太复杂。也可以用数据透视表,但每次都要刷新。用今天小编写的paiming函数一劳永逸,以后也可不用操心排行榜了。哦, 因为wps默认不支持Vba,想用还要安装VBA插件了。