如何按15人规模拆分82名参与者并分配指定组名至Sheet3

核心逻辑修正 #

你的问题出在组数量计算和组名匹配逻辑上：82人每组15人，实际需要6组（前5组15人，最后一组7人），而非15组。正确的组数量需通过向上取整计算，再通过循环给每个参与者匹配对应组名。

完整VBA代码 #

Sub AssignGroups()
    Dim wsSource As Worksheet, wsGroups As Worksheet, wsResult As Worksheet
    Dim totalParticipants As Long, groupSize As Integer, totalGroups As Integer
    Dim i As Long, groupNum As Integer
    
    ' 绑定工作表对象
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    Set wsGroups = ThisWorkbook.Sheets("Sheet2")
    Set wsResult = ThisWorkbook.Sheets("Sheet3")
    
    ' 清空结果表旧数据
    wsResult.Cells.Clear
    
    ' 设置每组人数
    groupSize = 15
    
    ' 获取总参与者数（假设数据在Sheet1的A列，A1为表头）
    totalParticipants = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row - 1
    
    ' 计算总组数（向上取整，确保最后一组不足人数也能分配）
    totalGroups = WorksheetFunction.Ceiling(totalParticipants / groupSize, 1)
    
    ' 写入结果表表头
    wsSource.Range("A1").Copy wsResult.Range("A1")
    wsResult.Range("B1").Value = "组名"
    
    ' 循环分配组名
    For i = 2 To totalParticipants + 1
        ' 计算当前参与者所属组号
        groupNum = Int((i - 2) / groupSize) + 1
        
        ' 复制参与者姓名到结果表
        wsSource.Cells(i, "A").Copy wsResult.Cells(i, "A")
        
        ' 从Sheet2读取对应组名并写入
        wsResult.Cells(i, "B").Value = wsGroups.Cells(groupNum + 1, "A").Value
    Next i
    
    ' 自动调整列宽
    wsResult.Columns("A:B").AutoFit
    
    MsgBox "分组完成！共生成" & totalGroups & "组", vbInformation
End Sub

关键代码说明 #

1. 组数计算：WorksheetFunction.Ceiling(totalParticipants / groupSize, 1)实现向上取整，避免遗漏最后一组不足15人的参与者。
2. 组号匹配：Int((i - 2) / groupSize) + 1通过索引偏移计算组号，确保每15人对应一个组名。
3. 工作表绑定：明确指定三个工作表对象，避免因工作表顺序变动导致的引用错误。

使用注意事项 #

• 确保Sheet1参与者数据在A列（A1为表头）；Sheet2组名在A列，Group1在A2、Group2在A3，组名数量需不少于计算出的总组数。
• 运行前建议备份数据，防止意外覆盖。

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