无论是学校的老师，还是从做销售管理，经常要做同一个工作：制作排行榜

很多人都是手工排序，然后手工添加名次：

麻烦在于名次要一个个的输入，因为有分数相同的，如果向下拖动复制容易出错。用rank函数也无法处理相同分数的问题。

除了语文，还有数学、化学等排名榜都需要你手工制作。下次数据更新后，还要手工操作一遍。

是不是很麻烦？是！

为了解决排行榜难题，编了一个自定义函数，可以实现自动生成排行榜。无论数据怎么变，排名榜都可以自动更新。

下面，只需要1分钟，你也可以生成自动更新的排名榜。

操作步骤：

1、复制下面代码

'示例用代码

Function PaiMing(rg As Range, rg1 As Range)Dim iOuter As LongDim iInner As LongDim iLBound As LongDim iUBound As LongDim iTemp As DoubleDim x As Long, k As LongDim arr1, arr2, arr3(1 To 10000, 1 To 3)arr1 = rgarr2 = rg1If UBound(arr1, 2) > 1 Thenarr1 = Application.Transpose(arr1)arr2 = Application.Transpose(arr2)End IfiLBound = LBound(arr1)iUBound = UBound(arr1)'冒泡排序For iOuter = iLBound To iUBoundFor 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) = iTemparr2(iInner, 1) = arr2(iInner + 1, 1)arr2(iInner + 1, 1) = iTemp1End IfNext iInnerNext iOuterFor x = 1 To UBound(arr1)arr3(x, 1) = arr2(x, 1)arr3(x, 2) = arr1(x, 1)k = k + 1If x > 1 ThenIf arr1(x, 1) = arr1(x - 1, 1) Then k = k - 1End Ifarr3(x, 3) = kNext xPaiMing = arr3End Function

2、粘贴代码

工作表标签右键 - 查看代码 - 在新打开的VBE窗口插入模块 - 把代码粘贴到右侧的窗口中，然后关闭窗口。

3、保存文件

当前文件另存为“Excel 启用宏的工作簿”

设置完成后，就可以使用排名函数了。

1、用法介绍

=PaiMing(数据区域,对应排名指标)

语法说明：

数据区域：要排名的数据区域，可以是一列区域，也可以是一行区域。

对应排名指标：和数据一一对应的指标。

2、设置方法

以生成语文排名为例，选取i3:k8区域（根据排行榜需要选取行数）,在编辑栏中输入公式

=PaiMing(B2:B15,A2:A15)

然后按Ctrl+Shift+Enter三键完成输入（输入后公式两边会添加大括号{})