能不能帮忙弄一个排序的宏

'可以指定列次序排序，列数可以不限
Option Explicit
Sub abc()
　Dim a, pos, i, j, k, p
　a = [a1].CurrentRegion.Offset(1).Value
　pos = Array(3, 4, 6, 5) 'C、D、F、E 列次序升序
　Call bsort(a, 1, UBound(a, 1) - 1, 1, UBound(a, 2), pos(0))
　For i = 1 To UBound(pos)
　　p = 0
　　For j = 1 To UBound(a, 1) - 1
　　　For k = i - 1 To 0 Step -1
　　　　If a(j, pos(k)) <> a(j + 1, pos(k)) Then
　　　　　Call bsort(a, p + 1, j, 1, UBound(a, 2), pos(i))
　　　　　p = j: Exit For
　　　　End If
　　　Next
　　Next
　Next
　[a1].Offset(1, UBound(a, 2) + 1).Resize(UBound(a, 1) - 1, UBound(a, 2)) = a
End Sub
Function bsort(a, 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 a(j, key) > a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function

可以来我B站看看，我最近开发了一款Excel无代码自动化办公软件Workflow
你可以完全按照自己的需求来写
【【自制框架】学会Workflow 腰不酸了臀不痛了，提前下班√ 升职加薪√】 https://www.bilibili.com/video/BV1j14y1N7cu/?share_source=copy_web&vd_source=0d213976060a52c1099e992b0823cc8f

'限定6列数据排序,纯数据不带标题
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　If Target.Rows.Count < 2 Or Target.Columns.Count <> 6 Then Exit Sub
　If Target.Rows.Count = Rows.Count Then Exit Sub
　Dim x, y, a, i, j, k, p, pos
　x = Target.Row: y = Target.Column
　a = Cells(x, y).Resize(Target.Rows.Count + 1, 6).Value
　pos = Array(3, 4, 6, 5) '后4列
　Call qsort(a, 1, UBound(a, 1) - 1, 1, 6, pos(0))
　For i = 1 To UBound(pos)
　　p = 0
　　For j = 1 To UBound(a, 1) - 1
　　　For k = i - 1 To 0 Step -1
　　　　If a(j, pos(k)) <> a(j + 1, pos(k)) Then
　　　　　If j - p > 2 Then Call qsort(a, p + 1, j, 1, 6, pos(i))
　　　　　p = j: Exit For
　　　　End If
　　　Next
　　Next
　Next
　Application.EnableEvents = False
　Cells(x, y).Resize(UBound(a, 1) - 1, 6) = a
　Application.EnableEvents = True
End Sub
Function qsort(a, first, last, left, right, key)
　Dim i As Long, j As Long, k As Long, x, t
　i = first: j = last: x = a((first + last) \ 2, key)
　While i <= j
　　While a(i, key) < x: i = i + 1: Wend
　　While x < a(j, key): j = j - 1: Wend
　　If i <= j Then
　　　For k = left To right
　　　　t = a(i, k): a(i, k) = a(j, k): a(j, k) = t
　　　Next
　　　i = i + 1: j = j - 1
　　End If
　Wend
　If first < j Then qsort a, first, j, left, right, key
　If i < last Then qsort a, i, last, left, right, key
End Function