Excel VBA使用循环为员工分配任务

Question

下午好,

我正在做一个创新的项目，似乎无法理解我需要做什么的逻辑。本质上，我试图分配一些员工到任务(现在只是填写数字，而不是他们的名字和实际任务)。以下是电子表格外观的基本说明

任务-任务位置-任务位置-任务材料

目前有45项任务，30名员工。我需要做的是：

• 随机分配员工名单，随机选择谁在做什么。
• 检查员工是否已被安排完成2项任务，因为每个人至少应该有一项任务，没有人有少于两项任务。
• 循环通过"Employee List“列，如果任务为空，且员工尚未被调度超过2个任务，则将该当前值从”员工列表“复制到”受让人“列中。

我知道这是模糊的，但我真的很感激你的帮助。我认为台阶有三重：

1. 随机化员工列表列
2. 给每个员工分配一次
3. 再随机化员工名单
4. 检查哪些任务仍然需要分配，然后检查员工是否已经安排了2项任务，如果没有，则分配这些任务。
5. 如果他们有，跳到下一个

有人能帮我想出解决办法吗？下面是我的当前代码，它对列进行排序，运行良好：

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

我认识到我可能需要更多的替补，并且愿意和任何能帮助我的人一起工作。事先，非常感谢。我正在努力发展逻辑，以完成我所需要的。

Answer 1

尝试这种随机分配员工的方法。

注意:您需要将employee列分配给一个数组。

下面是一个函数，它将接受一个员工数组，并输出一个随机名称：

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的吗？这是有意的，因为它将用一个包含所有名称的新数组替换您提供的输入数组，除了函数用来给出随机名称的那个。

您还需要这个函数来选择在上面的函数中调用的随机数：

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，但是我把它保存在那里，这样您就可以看到它是如何工作的。

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函数使用员工数组的一般指南。

因此，将您的任务放在一个循环中，使用randomEmployee函数一次分配每个任务。此函数将在分配员工时删除他们。

--一旦您的员工数组耗尽了--，您需要再次将整个员工列重新分配到您的数组中，因此请确保包括一个检查数组是否为空的系统。

编辑：

我对randomNumber函数执行了一个测试，目的是看看它实际上有多“随机”，在一百万行中使用介于0到10之间的范围：

​

每个结果都大致达到了9.1%，因此它看起来相当可靠。