根据总分高低每42人一档错班排序

taotaole1999

求助各位大神，请做个根据总分高低每42人一档错班排序

小凡、、、

每42个拆分一个sheet还是要干嘛

沈默00

已经排序好了，，，每42行重新排版还是干啥？？

yjh_27

错班=同班不相邻  ？

ykcbf1100

猜一个吧。

ykcbf1100

参与一下。。。。

1. Sub ykcbf()  '//2024.5.17
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     Set Rng = [a2].Resize(r - 1, 5)
   
4.     With Rng
   
5.         .Parent.Sort.SortFields.Clear
   
6.         .Sort key1:=.Item(2), order1:=1, key2:=.Item(4), order2:=2, Header:=2
   
7.     End With
   
8.     arr = Rng.Value
   
9.     lc = 42
   
10.     On Error Resume Next
    
11.     For i = 1 To UBound(arr)
    
12.         If i = 1 Then arr(i, 5) = 1
    
13.         If arr(i, 2) <> arr(i - 1, 2) Then m = 0: arr(i, 5) = 1
    
14.         If arr(i, 2) = arr(i - 1, 2) Then m = m + 1: arr(i, 5) = m
    
15.         If m = lc Then m = 0
    
16.     Next
    
17.     Rng.Value = arr
    
18.     Rng.Borders.LineStyle = 1
    
19. End Sub
    
20. 
    

复制代码

longwin

S型分班，不知道是否符合要求；

1. Sub test()
   
2. r = ActiveSheet.[A1].End(xlDown).Row
   
3. arr = ActiveSheet.Range("A1:E" & r)
   
4. zrs = UBound(arr) - 1
   
5. bjs = Round(zrs / 42 + 0.5, 0)
   
6. bj = 1
   
7. zf = 1
   
8. For i = 2 To UBound(arr)
   
9. 
   
10.     If bj = bjs + 1 Then
    
11.         bj = bjs
    
12.         zf = 0
    
13.     End If
    
14.    
    
15.     If bj = 0 Then
    
16.         bj = 1
    
17.         zf = 1
    
18.     End If
    
19.     arr(i, 5) = bj & "班"
    
20.    
    
21.     If zf = 1 Then
    
22.         bj = bj + 1
    
23.     Else
    
24.         bj = bj - 1
    
25.     End If
    
26.    
    
27. Next
    
28. 
    
29. ActiveSheet.Range("A1:E" & r) = arr

复制代码

taotaole1999

longwin 发表于 2024-5-17 21:22
S型分班，不知道是否符合要求；

谢谢，我是排考场用，最高分那部分人在第一考场，但前后左右不能坐在一起，所以要错班排序

taotaole1999

ykcbf1100 发表于 2024-5-17 20:12
参与一下。。。。

谢谢各位亲的热情相帮

taotaole1999

ykcbf1100 发表于 2024-5-17 20:12
参与一下。。。。

非常谢谢！