分组排名

42921783

排名结果如C列，请用VBA方法完成。

yjh_27

通用排名次自定义函数
http://club.excelhome.net/thread-1454513-1-1.html
(出处: ExcelHome技术论坛)

不知道为什么

如图

一把小刀闯天下

'组别可无序，，，

Option Explicit

Sub test()
  Dim arr, i, j
  arr = Range("a2:d" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  For i = 1 To UBound(arr, 1) - 1: arr(i, 4) = i: Next
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 1, True)
  For i = 1 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j, 1) <> arr(j + 1, 1) Then
        Call bsort(arr, i, j, 1, UBound(arr, 2), 2, False)
        Call rank(arr, i, j, 2, 3, True)
        i = j: Exit For
      End If
  Next j, i
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 4, True)
  [e2].Resize(UBound(arr, 1) - 1, UBound(arr, 2) - 1) = arr
End Sub

Function bsort(arr, first, last, left, right, key, order)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If arr(j, key) <> arr(j + 1, key) Then
        If arr(j, key) < arr(j + 1, key) Xor order Then
          For k = left To right
            t = arr(j, k): arr(j, k) = arr(j + 1, k): arr(j + 1, k) = t
          Next
        End If
      End If
  Next j, i
End Function

Function rank(arr, first, last, key, col, order)
  Dim i, j, m
  m = 1: arr(first, col) = 1
  For i = first + 1 To last
    If order Then
      m = m + 1
    Else
      If arr(i, key) <> arr(i - 1, key) Then m = m + 1
    End If
    arr(i, col) = IIf(arr(i, key) = arr(i - 1, key), arr(i - 1, col), m)
  Next
End Function