'数据量少冒个泡就可以了,否则可换归并,,,
Option Explicit
Sub test()
Dim arr, i, p
arr = [a1].CurrentRegion.Offset(1).Resize(, 3)
Call bsort(arr, 1, UBound(arr, 1) - 1, 1, UBound(arr, 2), 1, True)
For i = 1 To UBound(arr, 1) - 1
If arr(i, 1) <> arr(i + 1, 1) Then
Call bsort(arr, p + 1, i, 1, UBound(arr, 2), 3, False)
p = i
End If
Next
[e:e].NumberFormat = "yyyy-mm-dd"
[e2].Resize(UBound(arr, 1) - 1, UBound(arr, 2)) = 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
Next
End Function |