Excel VBA使用循环将员工分配给任务 [英] Excel VBA to assign employees to tasks using loops

问题描述

下午好，

我正在从事一个创新项目，似乎无法弄清楚我需要做什么的逻辑.本质上，我试图分配一些员工来执行任务(现在只是填写数字，而不是他们的姓名和实际任务).这是电子表格的基本外观

I am working on an innovative project and cannot seem to figure out the logic of what I need to do. Essentially, I am trying to assign a number of employees to tasks (right now just filling in numbers instead of their names and the actual tasks). Here is a basic look at what the spreadsheet looks like

任务|任务位置任务材料|难度|受让人|员工名单

Task | Task Location | Task Materials | Difficulty | Assignee | Employee List

目前有45个任务，有30名员工.我需要做的是:

There are currently 45 tasks, and 30 employees. What I need to do is:

• 随机分配员工列表以随机分配谁在做什么
• 检查该员工是否已安排完成两项任务，因为每个人都应至少拥有一项，而没有人少于两项
• 如果任务"为空并且尚未为雇员"安排超过2个任务，请遍历雇员列表"列，将当前值从雇员列表"复制到受让人"列中.

我知道这很模糊，但是我真的很感谢您的帮助.我认为步骤分为三个步骤:

I know this is vague, but I really would appreciate the help. I think the steps are three fold:

1. 随机化员工列表列
2. 为每个员工分配一次
3. 重新分配员工名单
4. 检查以查看仍然需要分配哪些任务，然后检查是否已经安排了该员工的2号工作，如果没有，则分配这些工作
5. 如果有，请跳过并移至下一个

有人可以帮助我设计解决方案吗?这是我当前的代码，该代码对列进行了排序，并且效果很好:

Could anybody help me devise a solution? Here is my current code, which sorts the column, and works well:

Sub ShufflePA()

    Application.ScreenUpdating = False

    Dim tempString As String, tempInteger As Integer, i As Integer, j As Integer, lastRow As Integer

    With Sheets("Test")
        lastRow = .Range("F" & .Rows.count).End(xlUp).Row
    End With

    For i = 6 To lastRow
        Cells(i, 7).Value = WorksheetFunction.RandBetween(0, 1000)
    Next i


    For i = 6 To lastRow
        For j = i + 1 To lastRow
            If Cells(j, 7).Value < Cells(i, 7).Value Then

                'change the string, which is the pa column...
                tempString = Cells(i, 6).Value
                Cells(i, 6).Value = Cells(j, 6).Value
                Cells(j, 6).Value = tempString

                tempInteger = Cells(i, 7).Value
                Cells(i, 7).Value = Cells(j, 7).Value
                Cells(j, 7).Value = tempInteger
            End If
        Next j
    Next i

    Worksheets("Test").Range("N:N").EntireColumn.Delete

    Application.ScreenUpdating = True

End Sub

我知道我可能会需要更多潜艇，并且愿意与任何可以帮助我的人一起工作.预先，非常感谢.我正在努力开发完成我所需要的逻辑.

I recognize I'll likely need some more subs, and would be willing to work with anybody who could help me. In advance, thank you very much. I am struggling to develop the logic to accomplish what I need.

推荐答案

尝试使用此方法随机分配员工.

Try this method for randomly assigning your employees.

注意:您将需要将雇员"列分配给数组

Note: You will need to assign your employee column to an array

这是一个函数，它将接收您的一组雇员，并输出一个随机名称:

Here is the Function that will take an array of your employees, and output a random name:

Function randomEmployee(ByRef employeeList As Variant) As String

    'Random # that will determine the employee chosen
    Dim Lotto As Long
    Lotto = randomNumber(LBound(employeeList), UBound(employeeList))
    randomEmployee = employeeList(Lotto)

    'Remove the employee from the original array before returning it to the sub
    Dim retArr() As Variant, i&, x&, numRem&
    numRem = UBound(employeeList) - 1
    ReDim retArr(numRem)
    For i = 0 To UBound(employeeList)
        If i <> Lotto Then
            retArr(x) = employeeList(i)
            x = x + 1
        End If
    Next i
    Erase employeeList
    employeeList = retArr

End Function

请注意我如何使用ByRef?这是有意的，因为它将用包含所有名称的新数组替换您提供的输入数组，但该函数用来给您随机名称的数组除外.

Notice how I used ByRef? This was intentional because it will replace the input array you provided with a new array that contains all the names, except the one that the function used to give you your random name.

您还需要此函数来选择在上述函数中调用的随机数:

You will also need this function to choose your random number that is called in the above function:

Function randomNumber(ByVal lngMin&, ByVal lngMax&) As Long
    'Courtesy of https://stackoverflow.com/a/22628599/5781745
    randomNumber = Int((lngMax - lngMin + 1) * Rnd + lngMin)
End Function

这是我使用的测试潜艇.显然，您不想保留我的empListArr，但我将其保留在此处，以便您了解其工作原理.

This was the test sub I had used. Obviously, you don't want to keep my empListArr, but I kept it there so you can see how this works.

Sub test()

    Dim empListArr()
    empListArr = Array("Bob", "Joe", "Erin", "Amber")

    Debug.Print "Employee Chosen: " & randomEmployee(empListArr)

    Dim i As Long
    For i = 0 To UBound(empListArr)
        Debug.Print "Remaining Employee: ";
        Debug.Print empListArr(i)
    Next

End Sub

同样，不打算将Test()子项添加到您的代码中.它可作为使用randomEmployee功能使用一组员工的一般指南.

Again, the Test() sub is not intended to be added to your code. It serves as a general guide on using your array of employees with the randomEmployee function.

因此将您的任务循环放置，使用randomEmployee函数一次分配一个任务.此功能将删除分配的员工.

So put your tasks in a loop, assigning each task one at a time with the randomEmployee function. This function will remove the employees as they are assigned.

一旦员工阵列用尽了，您需要将整个员工列重新分配给您的阵列，因此请确保您包含一个检查您的阵列是否为空的系统.

Once your array of employees are exhausted you need to reassign your entire column of employees to your array again, so ensure you include a system that checks if your array is empty or not.

我对randomNumber函数进行了测试，目的是查看它实际上是多么随机"，在一百万行中使用0到10之间的范围:

I performed a test on the randomNumber function just to see how "random" it actually was, using a range between 0 to 10 on a million lines:

每个结果大致达到9.1%，因此看起来非常可靠.

Each result hit roughly 9.1%, so it appears to be pretty reliable.

这篇关于Excel VBA使用循环将员工分配给任务的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！