直接针对数据的排序，谢谢gwjkkkkk老师、无关岁月和quqiyuan老师！

lhj323323

老师：

上传的附件里有写好的语句
可实现常规的排序
但我想实现【直接针对数组arr的排序】
老师如有空，请帮忙看看，先谢谢了
求助.rar (16.17 KB, 下载次数: 15)

2024-8-10 15:39 上传

点击文件名下载附件

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar
   
    Application.ScreenUpdating = False
   
    ar = [A1].CurrentRegion.Value
    bSort ar, 2, UBound(ar), 3, 3, 3
   
    [R1].CurrentRegion.ClearContents
    [R1].Resize(UBound(ar), UBound(ar, 2)) = ar
   
    Application.ScreenUpdating = True
    Beep
End Sub
Function bSort(ByRef ar, ByVal iFirst&, ByVal iLast&, ByVal iLeft&, _
    ByVal iRight&, ByVal iKey&, Optional isOrder As Boolean = True)
    Dim i&, j&, k&, vTemp
   
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j, iKey) <> ar(j + 1, iKey) Then
                If ar(j, iKey) < ar(j + 1, iKey) Xor isOrder Then
                    For k = iLeft To iRight
                        vTemp = ar(j, k)
                        ar(j, k) = ar(j + 1, k)
                        ar(j + 1, k) = vTemp
                    Next
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

，，，，，，，，，，，，，

ww87725244

这样？？？？？？？？？？

无关岁月

Sub test()
Dim arr()
Dim myr%
Application.ScreenUpdating = False
Application.EnableEvents = False

With Sheet1
    myr = .[a65536].End(xlUp).Row
    arr = .Range("a2:c" & myr)
End With

Call bsort(arr, 1, UBound(arr) - 1, 1, UBound(arr, 2), 2)

With Sheet1
    .Range("r1").Resize(UBound(arr), UBound(arr, 2)) = arr '能否改为直接针对arr的排序
End With

Application.ScreenUpdating = True
Application.EnableEvents = True
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 arr(j, key) < arr(j + 1, key) 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

lhj323323

gwjkkkkk 发表于 2024-8-10 15:53
，，，，，，，，，，，，，

谢谢老师
好像还是没有对



bSort ar, 2, UBound(ar), 3, 3, 3
2代表第2列吗？
那些3，分别代表什么意思？

lhj323323

ww87725244 发表于 2024-8-10 16:06
这样？？？？？？？？？？

老师

运行后，要报错
会不会是我使用的EXCEL版本2003过低的原因？

lhj323323

无关岁月 发表于 2024-8-10 16:10
Sub test()
Dim arr()
Dim myr%

无关岁月老师：
数据源的第8行，没有纳入排序

quqiyuan

参与一下，仅供参考。。。

lhj323323

无关岁月 发表于 2024-8-10 16:10
Sub test()
Dim arr()
Dim myr%

我把
'Call bsort(arr, 1, UBound(arr) - 1, 1, UBound(arr, 2), 2)
改为
Call bsort(arr, 1, UBound(arr), 1, UBound(arr, 2), 2)

好像就对了