Excel VBA宏开发需求：为每个任务分配两名在岗审核员并均衡任务量

1. 数据读取与基础校验 #

• 从审核员工作表抓取**状态为"In"**的人员：遍历表格（假设状态列在B列），把符合条件的审核员存入字典，同时初始化每个人的任务计数为0。如果未找到在岗审核员，直接弹出提示退出；如果在岗人数少于2，同样提示退出——毕竟每个任务需要2名不同的审核员。
• 读取待分配任务：从任务工作表获取所有非空的任务行，确认有任务可分配，否则直接退出。

2. 核心分配逻辑：保证均衡的关键 #

要实现每人任务量大致均衡，核心思路是每次选当前任务数最少的两名审核员：

• 先计算基准值：总任务数×2（每个任务占2个分配名额）除以在岗人数，得到每人理想承担数（可能带小数）。
• 维护可排序的审核员列表：每次分配前，把字典里的审核员按当前任务计数升序排列，取前两名分配给当前任务，随后将这两人的计数各加1。
• 处理余数：如果总名额（任务数×2）不能被人数整除，最后几个任务会让少数人多承担1个，这是合理的，确保最大任务量差距不超过1。
• 天然满足“两名不同审核员”：因为取的是列表里的前两名，必然是不同人员，无需额外判断。

3. 分配结果写入工作表 #

• 遍历任务列表，在任务表新增的“审核员1”“审核员2”列中写入分配的人员信息。
• 可选操作：生成一个统计页，列出每位审核员的任务数量，方便快速核对均衡性。

4. VBA代码核心片段参考 #

• 用字典存储审核员与对应任务计数：

  Dim auditorDict As Object
  Set auditorDict = CreateObject("Scripting.Dictionary")
  
  ' 读取在岗审核员
  Dim lastRow As Long, r As Range
  Dim wsAuditors As Worksheet
  Set wsAuditors = ThisWorkbook.Worksheets("审核员在岗记录")
  lastRow = wsAuditors.Cells(wsAuditors.Rows.Count, "A").End(xlUp).Row
  
  For Each r In wsAuditors.Range("A2:A" & lastRow)
      If UCase(r.Offset(0, 1).Value) = "IN" Then ' 统一转大写避免大小写差异
          auditorDict(r.Value) = 0
      End If
  Next r
  

• 排序审核员的辅助逻辑：将字典的键值对转成二维数组，用冒泡排序按计数升序排列，每次取前两个元素。
• 错误处理：添加判断块处理异常情况，比如：

  Dim wsTasks As Worksheet
  Set wsTasks = ThisWorkbook.Worksheets("任务列表")
  If wsTasks.Cells(wsTasks.Rows.Count, "A").End(xlUp).Row < 2 Then
      MsgBox "无待分配任务！", vbExclamation
      Exit Sub
  End If
  
  If auditorDict.Count < 2 Then
      MsgBox "在岗审核员不足2人，无法分配任务！", vbCritical
      Exit Sub
  End If
  

5. 优化细节 #

• 随机化选择：如果多个审核员计数相同，随机选取两人，避免固定顺序导致某些人总是优先被分配。
• 禁止搭档配置：若存在不能搭档的审核员组合，分配前检查选中的两人是否在禁止列表中，若是则更换为下一名任务计数最少的审核员。
• 一键重分配：添加表单按钮绑定宏，支持随时重新分配（覆盖原有结果）。

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