VBA代替RANK对单元格内数据字符串进行排列

乐开花36

怎样用VBA代替RANK对单元格内数据字符串进行排序,送花表谢意 VBA代替RANK.zip (8.05 KB, 下载次数: 9)

2018-10-13 14:03 上传

点击文件名下载附件

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, t, n
  arr = [d3].CurrentRegion
  For i = 1 To UBound(arr, 1)
    t = Split(arr(i, 1), ",")
    ReDim brr(UBound(t), 2)
    For j = 0 To UBound(t): brr(j, 0) = j: brr(j, 1) = t(j): Next
    Call dsort(brr, 1, False)
    n = 1: brr(0, 2) = 1
    For j = 1 To UBound(brr, 1)
      n = n + 1
      brr(j, 2) = IIf(Val(brr(j, 1)) = Val(brr(j - 1, 1)), brr(j - 1, 2), n)
    Next
    Call dsort(brr, 0, True)
    For j = 0 To UBound(t): t(j) = brr(j, 2): Next
    arr(i, 1) = Join(t, ",")
  Next
  [l3].Resize(UBound(arr, 1)) = arr
End Sub

Function dsort(arr, key, order)
  Dim i, j, t
  For i = 0 To UBound(arr, 1) - 1
    For j = i + 1 To UBound(arr, 1)
      If Val(arr(i, key)) < Val(arr(j, key)) Xor order Then
        t = arr(i, 0): arr(i, 0) = arr(j, 0): arr(j, 0) = t
        t = arr(i, 1): arr(i, 1) = arr(j, 1): arr(j, 1) = t
        t = arr(i, 2): arr(i, 2) = arr(j, 2): arr(j, 2) = t
      End If
  Next j, i
End Function