Question

下午好，

我正在研究一个创新项目，似乎无法弄清楚我需要做什么的逻辑。从本质上讲，我试图将一些员工分配给任务（现在只是填写数字而不是他们的名字和实际任务）。以下是电子表格的基本外观

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

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

随机分配员工列表以随机化谁在做什么
检查以确定该员工是否已安排完成2项任务，因为每个人都应该至少有一名没有人少于两名的人
循环通过＆＃34;员工列表＆＃34;如果任务为空并且员工尚未安排超过2个任务，请将当前值从员工列表复制到受理人列。

我知道这很模糊，但我真的很感激帮助。我认为这些步骤有三个方面：

随机化员工列表栏
分配每位员工
重新随机化员工名单
检查哪些任务仍需要分配，然后检查员工是否已安排为2，如果没有，则分配给他们
如果有，请跳过并移至下一个

有人可以帮我设计一个解决方案吗？这是我当前的代码，它对列进行排序，并且效果很好：

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功能进行了测试，看看＆＃34;随机＆＃34;实际上，在一百万行上使用0到10之间的范围：

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

Excel VBA使用循环

1 个答案:

编辑：