標籤：

再也不用加班做排行榜了，這個Excel函數可以搞定一切！

05-01

無論是學校的老師，還是從做銷售管理，經常要做同一個工作：製作排行榜

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

麻煩在於名次要一個個的輸入，因為有分數相同的，如果向下拖動複製容易出錯。用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插件了。

來源：Excel精英培訓 蘭色幻想-趙志東

PS：讓愛灑滿人間，16G的資料乾貨，傳送門放在評論了


推薦閱讀：

TAG:MicrosoftExcel | Excel使用 | Excel技巧 |