如何编写宏按课程排期时段分性别统计学生人数并输出至独立工作表

前置说明 #

• 代码默认原始数据存放在名为数据源的工作表中，列结构和你提供的示例一致：A列为课程排期时段、B列为班级、D列为性别，你可以根据自己的实际列位置调整代码内的列标识
• 统计结果会自动生成名为统计结果的新工作表，若工作簿内已存在同名工作表会先删除原有表

可直接使用的宏代码 #

Sub 按课程时段统计男女学生人数()
    Dim srcSheet As Worksheet, resSheet As Worksheet
    Dim lastRow As Long, i As Long, resRow As Long
    Dim key As String, classKey As String
    Dim dict As Object, classDict As Object
    ' 初始化字典存储统计结果
    Set dict = CreateObject("Scripting.Dictionary")
    Set srcSheet = ThisWorkbook.Worksheets("数据源") ' 可修改为你自己的原始数据工作表名
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row
    ' 遍历数据源统计人数，跳过表头行
    For i = 2 To lastRow
        key = srcSheet.Cells(i, "A").Value & "|" & srcSheet.Cells(i, "B").Value & "|" & srcSheet.Cells(i, "D").Value
        If dict.Exists(key) Then
            dict(key) = dict(key) + 1
        Else
            dict(key) = 1
        End If
    Next i
    ' 创建结果工作表
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Worksheets("统计结果").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Set resSheet = ThisWorkbook.Worksheets.Add(After:=srcSheet)
    resSheet.Name = "统计结果"
    ' 写入结果表头
    resSheet.Cells(1, "A") = "课程排期时段"
    resSheet.Cells(1, "B") = "班级"
    resSheet.Cells(1, "C") = "男生人数"
    resSheet.Cells(1, "D") = "女生人数"
    resRow = 2
    ' 整合同一时段同一班级的男女数据
    Set classDict = CreateObject("Scripting.Dictionary")
    Dim tempKey As Variant, keyArr As Variant
    For Each tempKey In dict.keys
        keyArr = Split(tempKey, "|")
        classKey = keyArr(0) & "|" & keyArr(1)
        If Not classDict.Exists(classKey) Then
            Set classDict(classKey) = CreateObject("Scripting.Dictionary")
            classDict(classKey)("男") = 0
            classDict(classKey)("女") = 0
        End If
        classDict(classKey)(keyArr(2)) = dict(tempKey)
    Next
    ' 写入统计结果
    For Each classKey In classDict.keys
        keyArr = Split(classKey, "|")
        resSheet.Cells(resRow, "A") = keyArr(0)
        resSheet.Cells(resRow, "B") = keyArr(1)
        resSheet.Cells(resRow, "C") = classDict(classKey)("男")
        resSheet.Cells(resRow, "D") = classDict(classKey)("女")
        resRow = resRow + 1
    Next
    ' 自动调整列宽
    resSheet.Columns("A:D").AutoFit
    MsgBox "统计完成，结果已保存到【统计结果】工作表", vbInformation
End Sub

使用注意事项 #

• 运行前请先开启Excel的宏功能，否则代码无法执行
• 如果你的原始数据列位置和默认假设不同，修改代码中对应Cells(i, "列标识")的列字母即可
• 如果原始数据工作表名不是数据源，修改Set srcSheet = ThisWorkbook.Worksheets("数据源")中的工作表名即可

内容的提问来源于stack exchange，提问作者macroni