'估计是要稳定排序,那就横向冒个泡吧,,,
Option Explicit
Sub test()
Dim arr, i As Long, j As Long, k As Long, t As Long
arr = Range("g1:q" & Cells(Rows.Count, "g").End(xlUp).Row)
For i = 8 To UBound(arr, 1)
If Len(arr(i, 1)) Then
For j = 1 To UBound(arr, 2) - 1
For k = 1 To UBound(arr, 2) - j
If arr(i, k) < arr(i, k + 1) Then
t = arr(1, k): arr(1, k) = arr(1, k + 1): arr(1, k + 1) = t
t = arr(i, k): arr(i, k) = arr(i, k + 1): arr(i, k + 1) = t
End If
Next
Next
For j = 1 To UBound(arr, 2)
arr(i, j) = arr(1, j): arr(1, j) = j
Next
End If
Next
[ag1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub |