多列分别提取不重复值并排序，谢谢！

一把小刀闯天下

a18b88 发表于 2019-12-5 20:28
大师要是单列提取不重复值并排序怎么写？谢谢您！

'--------------
'自己修改，如果数据量大换快排，，，

Option Explicit

Sub test()
  Dim arr, i, m
  arr = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row + 1)
  Call bsort(arr, 1, UBound(arr, 1) - 1, 1, 1, 1)
  For i = 1 To UBound(arr, 1) - 1
    If arr(i, 1) <> arr(i + 1, 1) Then
      m = m + 1: arr(m, 1) = arr(i, 1)
    End If
  Next
  [c1].Resize(m) = arr
End Sub

Function bsort(arr, first, last, left, right, key)
  Dim i, j, k, t
  For i = first To last - 1
    For j = first To last + first - 1 - i
      If StrComp(arr(j, key), arr(j + 1, key), vbTextCompare) = 1 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
    Next
  Next
End Function

一把小刀闯天下

a18b88 发表于 2019-12-5 20:28
大师要是单列提取不重复值并排序怎么写？谢谢您！

没搞懂没什么要审核，，，

a18b88

一把小刀闯天下 发表于 2019-12-5 20:49
没搞懂没什么要审核，，，

一把小刀闯天下 大师 早上好！你的作品真堪比妙手神功，真诚的感谢，并送上鲜花以示谢意。

a18b88

在 一把小刀闯天下 老师代码基础上做了些演绎供参考。

a18b88

附件： 单列提取不重复值并排序.rar (11.05 KB, 下载次数: 18)

2019-12-6 11:06 上传

点击文件名下载附件