我当前正在创建一个分发工具，以便根据每个人的定义百分比将人分发给任务。以下是受让人的示例数据及其各自的分配百分比，可以在我的“主表”中找到。只要分配的总数为100％，受让人就可以增长。
|---------------------|--------------------------------|
| Assignee | Distribution Percentage |
|---------------------|--------------------------------|
| Person1 | 25 |
|---------------------|--------------------------------|
| Person2 | 30 |
|---------------------|--------------------------------|
| Person2 | 45 |
|---------------------|--------------------------------|
在另一个名为“ New”的工作表中，我有一个任务列表，需要根据其定义的百分比分配给该人员。有时，在这种情况下，已经有一个指定的人员可以跳过分配给该任务的工作。
下面的内容还根据分配的定义百分比显示任务列表和预期输出（人员分配）。任务也可以增长：
|---------------------|--------------------------------|
| 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 |
|---------------------|--------------------------------|
在这种情况下，下面是分布：
人1-4-任务（25％）
人2-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 |
|---------------------|--------------------------------|
答案 0 :(得分：0)
如果您切换到循环浏览任务分配并检查是否已分配足够的任务，则使其工作起来可能会更容易。下面的代码为我完成了工作。
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