时间戳

首页 > 解决方案 > 有没有办法在考虑某些标准条件的同时将员工平均分配到大型任务列表中？

excel - 有没有办法在考虑某些标准条件的同时将员工平均分配到大型任务列表中？

问题描述

我有一个每月收到的动态任务群，我想将这些任务分配给 6 个组，以便他们以均匀分布的方式进行评估。每个任务都有一个排名/优先级，所以如果一个小组收到第一名的任务，我不想也给同一个小组前 100 个优先级。我想应用蛇形/之字形分布。

这使我走上了使用公式的道路=MIN(MOD(ROW()-2,12),MOD(-ROW()+1,12))。我得到了我正在寻找的分布，尽管在这个阶段我不知道如何解释我需要添加到我的逻辑中的任何标准。

在此处输入图像描述

在上图中，我试图将这些组纳入column F并将它们应用于Column D. Column E显示了=MOD()公式的示例，我可以使用查找将 Mod 值 0-5 替换为我的组 1-6。

我遇到障碍的地方是第 21 行，这是我想说明一些标准或例外情况的地方。我添加了一个用于可视化的二进制文件column A，但本质上，我想说的是 C 列（任务位置）= Loc4从不将任务分配给Group 4. 在我不希望将任务分配到 Loc 4 的第 4 组的情况下，我希望跳过Group 4单个分配，直到它可以应用于下一个可能的排序任务。简单的解决方案是在最后删除所有这些事件，但它确实扭曲了我想要的均匀分布。

我尝试将求解器应用于此作业，寻找最低标准偏差，但我有太多数据点。

这导致我使用一些 vba 逻辑写到另一篇文章，我真的很喜欢这个概念，但我不知道如何修改它以解决一些例外情况。在此处输入链接描述

理想情况下，我很想使用创建我的组的单个数组的概念，只要在这个简短的任务列表中满足标准，将每个组应用于任务，将组写入列表，重置并向下移动到下一个任务子集。因此，每次我选择接下来的 6 个任务时，它们都会分配到我的 6 个组中的一个，这将保持我希望的分布。

这是我试图应用的用户K.Davis帖子的代码：

    Sub assignEmployeeTasks()

            Dim ws As Worksheet, i As Long
        Set ws = ThisWorkbook.Worksheets(1)
        Dim employeeList() As Variant

        With ws
            For i = 2 To lastRow(ws, 2)
                If (Not employeeList) = -1 Then
                    'rebuild employeelist / array uninitialized
                    employeeList = buildOneDimArr(ws, "F", 2, lastRow(ws, "F"))
                End If
                .Cells(i, 4) = randomEmployee(employeeList)
            Next
        End With

    End Sub

这些是允许您的程序完成工作的“支持”功能： 

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
    If numRem = -1 Then     'array is empty
        Erase employeeList
        Exit Function
    End If
    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

' This will take your column of employees and place them in a 1-D array
Function buildOneDimArr(ByVal ws As Worksheet, ByVal Col As Variant, _
        ByVal rowStart As Long, ByVal rowEnd As Long) As Variant()

    Dim numElements As Long, i As Long, x As Long, retArr()
    numElements = rowEnd - rowStart
    ReDim retArr(numElements)

    For i = rowStart To rowEnd
        retArr(x) = ws.Cells(i, Col)
        x = x + 1
    Next i

    buildOneDimArr = retArr

End Function

' This outputs a random number so you can randomly assign your employee
Function randomNumber(ByVal lngMin&, ByVal lngMax&) As Long
    'Courtesy of https://stackoverflow.com/a/22628599/5781745
    Randomize
    randomNumber = Int((lngMax - lngMin + 1) * Rnd + lngMin)
End Function

' This gets the last row of any column you specify in the arguments
Function lastRow(ws As Worksheet, Col As Variant) As Long
    lastRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row
End Function

任何帮助将非常感激！我愿意走任何更接近我想要的解决方案、公式或 vba 的路径。请让我知道，如果你有任何问题。

谢谢！

标签： excelvbaloopsexcel-formula

解决方案

该程序在块大小是组计数的倍数时处理一个任务块。我有 SIZE=2 来给出 12 的块大小，因为这比 6 提供了更多解决冲突的机会。它的工作原理是最初将任务分配给 zigzap 模式，然后根据您定义的规则对其进行验证。这些在模块 validLocn() 中。如果验证正常，则该过程将工作表向下移动到下一个块。如果验证失败，则通过交换随机选择的 2 个元素并重试验证来打乱计划。这将继续增加由 MAXTRY 设置的最大数量。如果仍未解决，用户可以选择重试，忽略并继续或中止该过程。我用 150,000 条记录对其进行了测试，用时不到一分钟，但我的测试数据可能无法代表您的真实数据。结果在列 B、C 上的数据透视表中，

Count of Task                               
Row     Loc1    Loc2    Loc3    Loc4    Loc5    Loc6    Gand Total
Gp1     4013    3975    3926    5082    3986    4018    25000
Gp2     4021    3992    4077    4928    3975    4007    25000
Gp3     3976    3952    4027    5023    4049    3973    25000
Gp4     5050    4915    4936            5035    5064    25000
Gp5     4072    3996    4034    4890    3969    4039    25000
Gp6     3964    4087    3986    5018    3996    3949    25000                               
Grand  25096    24917   24986   24941   25010   25050   150000

希望有帮助。

Option Explicit
Sub assignEmployeeTasks()


    Dim ws As Worksheet, t0 As Single, t1 As Single
    Set ws = ThisWorkbook.Sheets("Sheet1")
    t0 = Timer

    Const COL_GROUP = "F"
    Const COL_LOCN = "C"
    Const SIZE As Integer = 2 ' plan size =  2 * group count

    Const MAXTRY = 50 ' no of tries to validate

    Dim bOK As Boolean
    Dim grp As Variant, iBlockStart As Long, i As Integer, r As Integer, step As Integer

     'initialize grps and location
    Dim countGrp As Integer, lastLocn As Long
    lastLocn = ws.Range(COL_LOCN & Rows.Count).End(xlUp).Row

    countGrp = ws.Range(COL_GROUP & Rows.Count).End(xlUp).Row - 1
    grp = ws.Range(COL_GROUP & "2").Resize(countGrp, 1).Value
    Dim plan() As String
    ReDim plan(countGrp * SIZE, 2)

    Dim itry As Integer, res
    iBlockStart = 1

    Do While iBlockStart < lastLocn

        ' initialize plan
        Call zigzag(plan, grp)
        For i = 1 To UBound(plan)
            plan(i, 1) = ws.Range("C" & iBlockStart + i).Value
        Next

        ' save 1st attempt
        For i = 1 To UBound(plan)
            ws.Range("D" & iBlockStart + i).Value = plan(i, 2)
        Next

        ' validate
        bOK = validLocn(plan, 0)

retry:

        ' retry to validate
        itry = 0
        While bOK = False And itry < MAXTRY
            Call shuffle(plan, 1)
            bOK = validLocn(plan, itry)
            itry = itry + 1
        Wend

        ' write new plan to sheet
        For i = 1 To UBound(plan)
            ws.Range("D" & iBlockStart + i).Value = plan(i, 2)
        Next

        ' check rule again
        If itry = MAXTRY Then
            ws.Range(COL_LOCN & iBlockStart).Select
            res = MsgBox("Failed to vaidate after " & MAXTRY & " attempts", vbAbortRetryIgnore, iBlockStart)
            If res = vbRetry Then GoTo retry
            If res = vbAbort Then Exit Sub
        End If
        iBlockStart = iBlockStart + UBound(plan)
    Loop
    t1 = Timer
    MsgBox "Assigned " & lastLocn - 1 & " tasks in " & Int(t1 - t0) & " secs"

End Sub

 ' valid plan against rules
Function validLocn(plan As Variant, itry) As Boolean
    Dim sLocn As String, sGrp As String, i As Integer

    validLocn = True
    For i = 1 To UBound(plan)
        sLocn = plan(i, 1)
        sGrp = plan(i, 2)
        ' rule 1
        If sGrp = "Gp4" And sLocn = "Loc4" Then
            validLocn = False
            'Debug.Print itry, i, "Fail Rule 1", sGrp, sLocn
        Else
            'Debug.Print itry, i, "Pass Rule 1", sGrp, sLocn
        End If
    Next
End Function

' populate plan groups
Sub zigzag(plan As Variant, grp As Variant)
    Dim i As Integer, r As Integer, step As Integer
    r = 1: step = 1
    For i = 1 To UBound(plan)
        plan(i, 2) = grp(r, 1)
        r = r + step
        If r > UBound(grp) Then
            r = UBound(grp)
            step = -1
        ElseIf r < 1 Then
           r = 1
           step = 1
        End If
    Next
End Sub

' shuffle plan
Sub shuffle(plan As Variant, i As Integer)
    Dim tmp As String, n As Integer, j As Integer, k As Integer
    For n = 1 To i
       ' random choose elements to shuffle
retry:
        k = Int(1 + Rnd() * UBound(plan))
        j = Int(1 + Rnd() * UBound(plan))
        If k = j Then GoTo retry
        tmp = plan(k, 2)
        plan(k, 2) = plan(j, 2)
        plan(j, 2) = tmp
    Next
End Sub


' generate test data
Sub testdata()
    Dim ws As Worksheet, i As Long
    Set ws = ThisWorkbook.Sheets("Sheet1")
    For i = 2 To 150001
        ws.Cells(i, 2) = i - 1
        ws.Cells(i, 3) = "Loc" & 1 + Int(Rnd() * 6)
    Next
End Sub

推荐阅读