怎样按班级名次s形排考号？

jnzhww

如表，想按各班的名次s形安排考号，如考号1是一班第一名，考号2是2班第一名，……，考号8是8班第一名，然后s形返回，考号9是8班第二名，考号10是7班第二名，，……，考号16是1班第二名，再返回，考号17是1班第三名，以此类推。

洋务德雷

排序就可以解决，看下面的GIF文件

3190496160

Sub 排考号()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim brr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet1")
    rs = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:i" & rs)
End With

For i = 2 To UBound(ar)
    For s = i + 1 To UBound(ar)
        If ar(i, 9) > ar(s, 9) Then
            For j = 1 To UBound(ar, 2)
                k = ar(i, j)
                ar(i, j) = ar(s, j)
                ar(s, j) = k
            Next j
        End If
    Next s
Next i
For i = 2 To UBound(ar)
    If Trim(ar(i, 2)) <> "" Then
        d(ar(i, 2)) = d(ar(i, 2)) + 1
    End If
Next i
sl = d.Count
ReDim arr(1 To UBound(ar), 1 To UBound(ar, 2) + 1)
With Sheets("排考号")
    .[a1].CurrentRegion.Offset(1) = Empty
    For i = 2 To UBound(ar) Step sl
        m = m + 1
        n = 0
        ReDim brr(1 To sl, 1 To UBound(ar, 2) + 1)
        For s = i To i + sl - 1
            If s <= UBound(ar) Then
                n = n + 1
                For j = 1 To UBound(ar, 2)
                    brr(n, j) = ar(s, j)
                Next j
            End If
        Next s
        If m Mod 2 <> 0 Then
            For s = 1 To n
                Y = Y + 1
                For ss = s + 1 To n
                    If brr(s, 2) > brr(ss, 2) Then
                        For j = 1 To UBound(brr, 2)
                            k = brr(s, j)
                            brr(s, j) = brr(ss, j)
                            brr(ss, j) = k
                        Next j
                    End If
                Next ss
                brr(s, UBound(brr, 2)) = Y
            Next s
        ElseIf m Mod 2 = 0 Then
            For s = 1 To n
                Y = Y + 1
                For ss = s + 1 To n
                    If brr(s, 2) < brr(ss, 2) Then
                        For j = 1 To UBound(brr, 2)
                            k = brr(s, j)
                            brr(s, j) = brr(ss, j)
                            brr(ss, j) = k
                        Next j
                    End If
                Next ss
                brr(s, UBound(brr, 2)) = Y
            Next s
        End If
        ws = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Cells(ws, 1).Resize(n, UBound(brr, 2)) = brr
    Next i
End With
MsgBox "ok!"
End Sub

3190496160

班级排名不要用并列名次，顺序往下排
全年级.rar (73.21 KB, 下载次数: 18)

2022-5-13 10:37 上传

点击文件名下载附件

熊文来

3190496160 发表于 2022-5-13 10:37
班级排名不要用并列名次，顺序往下排

很好的作品，我有一个类似的需求。改天找您帮忙 行吗？

3190496160

熊文来 发表于 2022-5-16 21:16
很好的作品，我有一个类似的需求。改天找您帮忙 行吗？

可以啊，只是要看你的需求啥样的

cdcxzj

前面说排序确实可以解决，但是动画是不是少了一点步骤，看不太明白。
1\排序（均升序），第一条件为班次（8个1，8个2，8个3等），第二条件为班级（1-8班）；
2\找出偶数班次（2，4，6等名次），并倒序，J2=if(mod(i2,2)=1,b2,9-b2)
3\再次排序（均升序），第一条件为班次，第二条件为J列
4\K列填充序列（1，2，3，4……），即考号。

ruijiaqi

=INDEX($A:$A,MAX(($B$2:$B$440=INT(MOD(ROW($A1)-1,8)+1))*($I$2:$I$440=INT((ROW($A1)-1)/8+1))*ROW($A$2:$A$440)))