排序

zyf19890315

麻烦各位大神帮忙看下怎么能按照要求排序 ，谢谢

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   With Worksheets("sheet1")
   
5.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
6.     .Range("a2:b" & r).Sort key1:=.Range("a2"), order1:=xlAscending, key2:=.Range("b2"), order2:=xlDescending, Header:=xlNo
   
7.     arr = .Range("a2:c" & r)
   
8.     xm1 = ""
   
9.     For i = 1 To UBound(arr)
   
10.       If arr(i, 1) <> xm1 Then
    
11.         m = 0
    
12.         xm1 = arr(i, 1)
    
13.         xm2 = ""
    
14.       End If
    
15.       If arr(i, 2) <> xm2 Then
    
16.         m = m + 1
    
17.         xm2 = arr(i, 2)
    
18.       End If
    
19.       arr(i, 3) = m
    
20.     Next
    
21.     .Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
22.   End With
    
23. End Sub
    

复制代码

chxw68

详见附件。

ykcbf1100

排序。。。。

ykcbf1100

1. Sub ykcbf()   '//2025.3.15
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = Range("a2:c" & r)
   
4.     Set Rng = Range("k2:m" & r)
   
5.     Rng.Value = arr
   
6.     With Rng
   
7.         .Parent.Sort.SortFields.Clear
   
8.         .Sort key1:=.Item(1), order1:=1, key2:=.Item(2), order2:=2, Header:=2
   
9.     End With
   
10.     arr = Range("k1:m" & r)
    
11.     For i = 2 To UBound(arr)
    
12.         If arr(i, 1) <> arr(i - 1, 1) Then m = 0
    
13.         If arr(i, 2) <> arr(i - 1, 2) Then m = m + 1
    
14.         Cells(i, "m") = m
    
15.     Next
    
16.     MsgBox "OK！"
    
17. End Sub
    

复制代码