需开发Excel VBA宏：按人数均分"xyz"记录并跳过"abc"记录

以下是修改后的VBA宏，完全满足需求：仅给标记为xyz的记录均分分配人员，标记为abc的记录B列留空，同时适配动态的记录数量和人员列表。

Sub AssignRecords()
    Dim peopleArr As Variant
    Dim recordsWs As Worksheet, peopleWs As Worksheet
    Dim lastRecordRow As Long, lastPersonRow As Long
    Dim xyzCount As Long, personIndex As Integer
    Dim i As Long, assignCounter As Integer
    
    ' 绑定工作表对象
    Set recordsWs = ThisWorkbook.Sheets("Records")
    Set peopleWs = ThisWorkbook.Sheets("People")
    
    ' 获取人员列表（从A2开始到最后一行）
    lastPersonRow = peopleWs.Cells(Rows.Count, "A").End(xlUp).Row
    If lastPersonRow < 2 Then
        MsgBox "People工作表中没有可分配的人员！", vbExclamation
        Exit Sub
    End If
    peopleArr = peopleWs.Range("A2:A" & lastPersonRow).Value
    
    ' 获取记录的最后一行
    lastRecordRow = recordsWs.Cells(Rows.Count, "A").End(xlUp).Row
    If lastRecordRow < 2 Then
        MsgBox "Records工作表中没有记录！", vbExclamation
        Exit Sub
    End If
    
    ' 统计需要分配的xyz记录总数
    xyzCount = Application.WorksheetFunction.CountIf(recordsWs.Range("A2:A" & lastRecordRow), "xyz")
    If xyzCount = 0 Then
        MsgBox "没有标记为xyz的记录需要分配！", vbInformation
        recordsWs.Range("B2:B" & lastRecordRow).ClearContents
        Exit Sub
    End If
    
    ' 初始化分配计数器和人员索引
    assignCounter = 0
    personIndex = 1
    
    ' 遍历每条记录完成分配
    For i = 2 To lastRecordRow
        Select Case recordsWs.Cells(i, "A").Value
            Case "xyz"
                ' 给当前xyz记录分配人员
                recordsWs.Cells(i, "B").Value = peopleArr(personIndex, 1)
                assignCounter = assignCounter + 1
                
                ' 判断是否切换到下一个人员，处理均分+余数分配
                If assignCounter > (xyzCount \ UBound(peopleArr, 1)) + IIf(personIndex <= xyzCount Mod UBound(peopleArr, 1), 1, 0) Then
                    assignCounter = 1
                    personIndex = personIndex + 1
                    If personIndex > UBound(peopleArr, 1) Then personIndex = 1
                End If
            Case "abc"
                ' abc记录清空B列内容
                recordsWs.Cells(i, "B").ClearContents
        End Select
    Next i
End Sub

关键改进说明 #

• 标记判断逻辑：通过Select Case区分xyz/abc记录，只对xyz执行分配操作，abc记录直接清空B列。
• 精准均分计算：基于xyz记录的实际数量均分，无法整除时，前xyzCount Mod 人员数量个人员会多分配1条记录，保证分配最均匀。
• 边界异常处理：增加人员列表为空、无有效分配记录等场景的提示，避免宏运行报错。
• 工作表显式绑定：明确指定工作表对象，避免因当前活动工作表变化导致的逻辑错误。

原代码的问题 #

原代码直接对整个B列批量填充人员列表，没有判断A列的标记类型，因此无法跳过abc记录，同时分配逻辑是基于总记录数而非有效xyz记录数，不符合均分需求。

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