Excel VBA 班级学生按成绩分组，使得平均分接近

本文于2023年8月24日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

内容提要

• 班级学生按成绩分组，平均分接近

大家好，我是冷水泡茶，昨天在EXCELHOME论坛上看到一个坛友的求助贴：

他的数据表如下，要求分成3组，使得人数平均分接近：

咋一看，好象不太好搞，条件有点宽泛，再一想，好象通过排序，然后再按顺序把学生塞到一个个小组里不就成了？好象没什么问题，于是我就作了回复：

排序，分几组，就隔几人抽一个。打篮球，踢足球选队员有没有玩过？

今天又上论坛，看到这个问题好象还没有完美解决，既然他要VBA我们就用VBA来试一试吧，这简直不要太简单（高兴得有点早了）：

（唉，现在论坛审核得这么严了吗？我都发了几个小时了，回复还没通过。）

等我动手做的时候，很快做出了结果，每隔3人取一个，但突然想起，我们打篮球选队员的时候，并不是直接按顺序来选的，要么是每一轮都猜拳，谁赢了谁先选，要么第一轮先选，下一轮后选，以保证实力均衡。看来我的回复是有问题的，只好重新考虑分组方法，终于还是基本搞成功了，每轮颠倒抽取顺序，我们一起来看一看：

基本思路

1、首先， 把数据存入数组，我给他的数据前面加了一列“序号”，后面加了一列“分组”（本来是想直接在工作表中进行排序、分组操作的，加序号是保证数据顺序能恢复到原始排序状态。但后来还是在数组中操作了。）。

2、然后，把数组按照总分进行排序，升降序无所谓。

3、接着，根据分组的数量，在数组的第4列写入1、2、3、3、2、1这样的数字序列，代表各组的编号。

5、最后，把数组再次按照“分组“进行排序，并把结果写到一个工作表中。

程序代码

1、模块1，stuGrouping过程，学生分组：

Sub stuGrouping(Optional Num As Integer = 3)
    On Error Resume Next
    Dim ws As Worksheet
    Dim lastRow As Integer
    Dim lastCol As Integer
    Dim arrData()
    Dim arrSequence()
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Activate
    lastRow = ws.UsedRange.Rows.Count
    lastCol = 4
    arrData = ws.Range(Cells(2, 1), Cells(lastRow, lastCol)).Value
    ReDim arrSequence(1 To Num)
    For i = 1 To Num
        j = Num - i + 1
        arrSequence(i) = j
    Next
    arrData = SortArray(arrData, True, False, 3)
    lastRow = UBound(arrData)
    For i = 1 To lastRow
        If (i - 1) Mod Num + 1 = 1 Then
            k = k + 1
        End If
        If k Mod 2 = 0 Then
            arrData(i, 4) = arrSequence((i - 1) Mod Num + 1)
        Else
            arrData(i, 4) = (i - 1) Mod Num + 1
        End If
    Next
    arrData = SortArray(arrData, , , 4)
    With Sheets("TEM")
        .Activate
        .Cells.Clear
        .Range("A1:D1") = ws.Range("A1:D1").Value
        .Range("A2").Resize(UBound(arrData), UBound(arrData, 2)) = arrData
        .Range("A1").Select
    End With
End Sub

?代码解析：

（1）定义一些变量，工作表对象ws，数组。过程设置了一个参数，分组数。

（2）line8~12，把Sheet1表原始数据读入数组。

（3）line13~17，把数组arrSequence的值写成从分组数到1的倒序的数字序列。

（4）line18，利用自定义函数SortArray对数组按第3列进行行降序排序。

（5）line20~29，循环数组，对行号除以分组数求余，当它等于1时，表示是新一轮分组开始，k+1。接着判断k除以2求余，如果等于0,表明是偶数轮，我们就把原来序列号是1~num的，给它倒过来。使得分组更均匀，平均分更接近。

（6）line30，这一行再次对数组按第4列分组进行排序，使得同一组的学生排列在一起。（也可以分成几列写到工作表）。如果要看出分组过程，可以把这句注释掉，我们就可以看到分组数据是像1、2、3、3、2、1、1、2、3......这样的形式排序的。

（7）把数组写入工作表“TEM”，就算完工。

2、其他过程：CmdGroup，分组命令按钮，SortArray，数组排序自定义函

数：

Private Sub CmdGroup_Click()
    Dim Num As Integer, inputNum As String
    inputNum = InputBox("请输入分组数:", , 3)
    Num = CInt(inputNum)
    Call stuGrouping(Num)
End Sub

Function SortArray(ByRef arr() As Variant, _
    Optional sortByRow As Boolean = True, _
    Optional ascending As Boolean = True, _
    Optional sortByIndex As Long = 1) As Variant
    Dim numRows As Long
    Dim numCols As Long
    Dim i As Long, j As Long
    Dim temp As Variant
    numRows = UBound(arr, 1)
    numCols = UBound(arr, 2)
    If sortByRow Then
        ' 按行排序
        For i = 1 To numRows - 1
            For j = i + 1 To numRows
                If (arr(i, sortByIndex) > arr(j, sortByIndex) And _
                    ascending) Or (arr(i, sortByIndex) < arr(j, sortByIndex) And Not ascending) Then
                     ' 交换行
                    For k = 1 To numCols
                        temp = arr(i, k)
                        arr(i, k) = arr(j, k)
                        arr(j, k) = temp
                    Next k
                End If
            Next j
        Next i
    Else
        ' 按列排序
        For i = 1 To numCols - 1
            For j = i + 1 To numCols
                If (arr(sortByIndex, i) > arr(sortByIndex, j) And _
                    ascending) Or (arr(sortByIndex, i) < arr(sortByIndex, j) And Not ascending) Then
                    ' 交换列
                    For k = 1 To numRows
                        temp = arr(k, i)
                        arr(k, i) = arr(k, j)
                        arr(k, j) = temp
                    Next k
                End If
            Next j
        Next i
    End If
    
    SortArray = arr
End Function

代码解析：

（1）CmdGroup，通过inputbox提示输入分组数，然后调用StuGrouping分组过程，以输入的数字为参数。

（2）SortArray这是参考AI写的代码，可以将数组按行、列，对指定的列、行进行升、降序排序。

~~~~~~End~~~~~~

喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！