按组分配场地：Excel公式存在剩余空位问题，寻求VBA解决方案

嘿，我刚好处理过类似的场地分配需求，你的ROUNDDOWN公式问题出在只取了整除的部分，没把剩余场地分配出去对吧？下面给你几个实用的VBA方案，保证所有场地都能合理分配，不会有剩余空场地：

这个方案适合快速测试分配逻辑，结果会打印在VBA编辑器的立即窗口里：

Sub AllocateSlots()
    Dim totalSlots As Integer, totalGroups As Integer
    Dim baseSlots As Integer, remainingSlots As Integer
    Dim i As Integer
    
    ' 你可以把这里的硬编码改成从单元格读取，比如 totalSlots = Range("B6").Value
    totalSlots = 7 ' 示例：总场地数
    totalGroups = 3 ' 示例：总组数
    
    ' 合法性检查：避免除以0的错误
    If totalGroups = 0 Then
        MsgBox "组数不能为0！", vbExclamation
        Exit Sub
    End If
    
    ' 计算基础配额和剩余场地数
    baseSlots = Int(totalSlots / totalGroups)
    remainingSlots = totalSlots Mod totalGroups
    
    ' 输出分配结果
    Debug.Print "=== 场地分配结果 ==="
    For i = 1 To totalGroups
        If i <= remainingSlots Then
            Debug.Print "第" & i & "组：" & baseSlots + 1 & "个场地"
        Else
            Debug.Print "第" & i & "组：" & baseSlots & "个场地"
        End If
    Next i
End Sub

逻辑说明：先算每组的基础配额（整除结果），再把剩下的场地依次分给前N组（N等于剩余场地数），这样所有场地都能分配完。比如7个场地分给3组，就是前2组各3个，最后1组1个，刚好分完。

如果需要把分配结果直接写到Excel表格里，用这个子程序更方便，还会自动调整列宽：

Sub AllocateSlotsToSheet()
    Dim totalSlots As Integer, totalGroups As Integer
    Dim baseSlots As Integer, remainingSlots As Integer
    Dim i As Integer
    Dim outputStart As Range
    
    ' 从指定单元格读取参数（假设场地数在B6，组数在B5）
    totalSlots = Range("B6").Value
    totalGroups = Range("B5").Value
    
    ' 多一层合法性检查，避免负数输入
    If totalGroups = 0 Then
        MsgBox "组数不能为0，请检查输入！", vbExclamation
        Exit Sub
    End If
    If totalSlots < 0 Or totalGroups < 0 Then
        MsgBox "场地数和组数不能为负数！", vbExclamation
        Exit Sub
    End If
    
    baseSlots = Int(totalSlots / totalGroups)
    remainingSlots = totalSlots Mod totalGroups
    
    ' 设置输出起始位置，比如从A1开始
    Set outputStart = Range("A1")
    
    ' 写入表头
    outputStart.Value = "组号"
    outputStart.Offset(0, 1).Value = "分配场地数"
    
    ' 写入每组的分配结果
    For i = 1 To totalGroups
        outputStart.Offset(i, 0).Value = "第" & i & "组"
        If i <= remainingSlots Then
            outputStart.Offset(i, 1).Value = baseSlots + 1
        Else
            outputStart.Offset(i, 1).Value = baseSlots
        End If
    Next i
    
    ' 自动调整列宽，让内容更美观
    outputStart.Resize(totalGroups + 1, 2).Columns.AutoFit
    MsgBox "分配完成！结果已写入工作表。", vbInformation
End Sub

如果想在Excel单元格里直接获取某一组的分配数，可以写个自定义函数，像用普通公式一样调用：

Function ALLOCATESLOTS(totalGroups As Integer, totalSlots As Integer, groupNumber As Integer) As Integer
    Dim baseSlots As Integer, remainingSlots As Integer
    
    ' 错误处理：返回特定值提示问题
    If totalGroups = 0 Then
        ALLOCATESLOTS = -1 ' 返回-1表示组数为0的错误
        Exit Function
    End If
    If groupNumber < 1 Or groupNumber > totalGroups Then
        ALLOCATESLOTS = -2 ' 返回-2表示组号超出范围
        Exit Function
    End If
    
    baseSlots = Int(totalSlots / totalGroups)
    remainingSlots = totalSlots Mod totalGroups
    
    ' 返回对应组的场地数
    If groupNumber <= remainingSlots Then
        ALLOCATESLOTS = baseSlots + 1
    Else
        ALLOCATESLOTS = baseSlots
    End If
End Function

使用方法：在单元格里输入=ALLOCATESLOTS(B5,B6,A2)，其中B5是总组数，B6是总场地数，A2是你要查询的组号（比如1、2、3...）。如果返回-1，说明组数为0；返回-2，说明组号输入错误。

这些方案的核心逻辑都是先均分基础配额，再将余数逐个分配给前面的组，完美解决你之前公式留下的剩余场地问题~

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