按条件排序

ykcbf1100

chzsh 发表于 2025-3-20 14:31
这里出现错误

可能是你版本有关系。我是：win11+office2021
office高版本应该问题不大。

这样试一下。。。

今铭昔

翁知江安

Sub test()
Dim i, j, m, n As Integer
Dim ar, br, cr As Variant
ar = Sheet1.[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
   If ar(i, 1) = "早" Then
   m = m + 1
   For j = 1 To UBound(ar, 2)
    br(m, j) = ar(i, j)
    Next
   Else
   n = n + 1
   For j = 1 To UBound(ar, 2)
    cr(n, j) = ar(i, j)
    Next
   End If
Next
With Sheet1
.[m1].Resize(1000, UBound(ar, 2)).ClearContents
.[m1].Resize(m, UBound(ar, 2)) = br
.[m1].Select
.[m1].Resize(m, UBound(ar, 2)).Sort key1:=Columns("w"), order1:=xlDescending, Header:=xlNo
br = .[m1].Resize(m, UBound(ar, 2))
.[m1].Resize(1000, UBound(ar, 2)).ClearContents
.[m1].Resize(n, UBound(ar, 2)) = cr
.[m1].Select
.[m1].Resize(n, UBound(ar, 2)).Sort key1:=Columns("w"), order1:=xlDescending, Header:=xlNo
cr = .[m1].Resize(n, UBound(ar, 2))
.[m1].Resize(1000, UBound(ar, 2)).ClearContents
.[a2].Resize(m, UBound(ar, 2)) = br
.Cells(m + 2, 1).Resize(n, UBound(ar, 2)) = cr
End With
MsgBox "ok"
End Sub

翁知江安

供参考，欢迎批评指正