我目前正在创建一个分发工具，以便根据每个人定义的百分比将人员分配到任务。以下是受让人的样本数据及其各自的分配百分比，可在我的“主表”中找到。只要分配总额为100％，受让人就可以增长。
|---------------------|--------------------------------|
| Assignee | Distribution Percentage |
|---------------------|--------------------------------|
| Person1 | 25 |
|---------------------|--------------------------------|
| Person2 | 30 |
|---------------------|--------------------------------|
| Person2 | 45 |
|---------------------|--------------------------------|
在另一张名为“新”的表中，我有一个需要根据其定义的百分比分配给该人的任务列表。有时，在这种情况下，已经有一个指定人员跳过分配给该任务。
下面还根据分配的定义百分比显示任务列表和预期输出（人员分配）。任务也可以增长：
|---------------------|--------------------------------|
| Assignee | Tasks |
|---------------------|--------------------------------|
| Person1 | Task 1 |
|---------------------|--------------------------------|
| Person1 | Task 2 |
|---------------------|--------------------------------|
| Person1 | Task 3 |
|---------------------|--------------------------------|
| Person1 | Task 4 |
|---------------------|--------------------------------|
| Person2 | Task 5 |
|---------------------|--------------------------------|
| Person2 | Task 6 |
|---------------------|--------------------------------|
| Person2 | Task 7 |
|---------------------|--------------------------------|
| Person2 | Task 8 |
|---------------------|--------------------------------|
| Person3 | Task 9 |
|---------------------|--------------------------------|
| Person3 | Task 10 |
|---------------------|--------------------------------|
| Person3 | Task 11 |
|---------------------|--------------------------------|
| Person3 | Task 12 |
|---------------------|--------------------------------|
| Person3 | Task 13 |
|---------------------|--------------------------------|
| Person3 | Task 14 |
|---------------------|--------------------------------|
| Person3 | Task 15 |
|---------------------|--------------------------------|
在这种情况下，下面是分布：
Person1 - 4任务（25％）
Person2 - 4任务（30％）
Person3 - 7任务（45％）
下面是我的工作代码。但是，它不符合我需要的输出。我一直在坚持如何继续：
Sub AssignPercentage()
Dim PersonFirstRow As Integer
Dim PersonLastRow As Long
Dim PersonRow As Long
Set mainSheet = Sheets("Main")
Set TodaySheet = Sheets("New")
Dim LastRow As Long, LastColumn As Long
Dim StartCell As Range, rng As Range
Dim x As Long
Dim cl As Range
Dim Percentage As Long, i As Long
Dim PersonPercent As Long
Set StartCell = TodaySheet.Range("B2")
PersonFirstRow = 10 'row of F12
PersonLastRow = mainSheet.Cells(mainSheet.Rows.Count, "E").End(xlUp).Row
LastRow = TodaySheet.Cells(TodaySheet.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = TodaySheet.Cells(StartCell.Row, TodaySheet.Columns.Count).End(xlToLeft).Column
Set rng = TodaySheet.Range(StartCell, TodaySheet.Cells(LastRow, 2))
For x = PersonFirstRow To PersonLastRow
PersonPercent = mainSheet.Cells(x, "F").Value
Percentage = Round(rng.Rows.Count * PersonPercent / 100, 0)
For Each cl In rng
i = i + 1
If i > Percentage Then
i = 0
Exit For
End If
If Trim(cl.Offset(0, -1).Value) = "" Then
cl.Offset(0, -1).Value = mainSheet.Cells(x, "E").Value
End If
Next cl
Next x
End Sub
上面代码的输出如下，这是不正确的：
|---------------------|--------------------------------|
| Assignee | Tasks |
|---------------------|--------------------------------|
| Person1 | Task 1 |
|---------------------|--------------------------------|
| Person1 | Task 2 |
|---------------------|--------------------------------|
| Person1 | Task 3 |
|---------------------|--------------------------------|
| Person1 | Task 4 |
|---------------------|--------------------------------|
| Person3 | Task 5 |
|---------------------|--------------------------------|
| Person3 | Task 6 |
|---------------------|--------------------------------|
| Person3 | Task 7 |
|---------------------|--------------------------------|
| | Task 8 |
|---------------------|--------------------------------|
| | Task 9 |
|---------------------|--------------------------------|
| | Task 10 |
|---------------------|--------------------------------|
| | Task 11 |
|---------------------|--------------------------------|
| | Task 12 |
|---------------------|--------------------------------|
| | Task 13 |
|---------------------|--------------------------------|
| | Task 14 |
|---------------------|--------------------------------|
| | Task 15 |
|---------------------|--------------------------------|
如果您交换循环任务分配并检查是否已分配了足够的任务，则可能更容易使其工作。以下代码为我完成了这项工作。
Dim PersonFirstRow As Integer
Dim PersonLastRow As Long
Dim PersonRow As Long
Set mainsheet = Sheets("Main")
Set todaysheet = Sheets("New")
Dim LastRow As Long, LastColumn As Long
Dim StartCell As Range, rng As Range
Dim Percentage As Long, i As Long
Dim PersonPercent As Long
Dim TaskRow, AssignedTasks As Long
Set StartCell = todaysheet.Range("B2")
PersonFirstRow = 10 'row of F12
PersonLastRow = mainsheet.Cells(mainsheet.Rows.Count, "E").End(xlUp).Row
LastRow = todaysheet.Cells(todaysheet.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = todaysheet.Cells(StartCell.Row, todaysheet.Columns.Count).End(xlToLeft).Column
Set rng = todaysheet.Range(StartCell, todaysheet.Cells(LastRow, 2))
For TaskRow = 2 To LastRow
For PersonRow = 10 To PersonLastRow
PersonPercent = mainsheet.Cells(PersonRow, "F").Value
Percentage = Round(rng.Rows.Count * PersonPercent / 100, 0)
AssignedTasks = Application.WorksheetFunction.CountIf(rng.Offset(0, -1), mainsheet.Cells(PersonRow, 5).Value)
If AssignedTasks + 1 <= Percentage Then
If Trim(todaysheet.Cells(TaskRow, 1).Value) = "" Then
todaysheet.Cells(TaskRow, 1).Value = mainsheet.Cells(PersonRow, "E").Value
End If
End If
Next PersonRow
Next TaskRow
End Sub