随机分配员工参加任务 [英] Randomly Assign Employees to Tasks

问题描述

这是我先前提出的问题的后续措施.提供了答案，但是由于我自己的经验和能力不足，我似乎无法正确实施它.

This is a follow-up to a previous question that I had. I was provided an answer, but due to my own inexperience and inability, I can't seem to implement it properly.

我的情况如下: 我需要为任务分配员工列表.

My situation is as follows: I need to assign a list of employees to tasks.

• 总会有比员工更多的任务.
• 每位员工必须至少分配一个人
• 任何员工均不得分配两个以上
• 我需要员工列表在排序过程中随机化，以便同一位员工不会一遍又一遍地完成相同的任务

我要说的是找到一种方法来开始分配"员工，跟踪array(i)员工已分配了多少次，如果大于两次，请转到下一个.

Where I am coming up short is finding a way that starts "assigning" employees, keeps track of how many times the array(i) employee has been assigned, and if it's greater than two, move onto the next.

一个很棒的用户尝试在这里帮助我:

An awesome user tried helping me here: Excel VBA to assign employees to tasks using loops

这是我正在使用的测试"表:

Here is the "test" table I am working with:

这是我编写的用于对我的员工列表进行排序的宏，该宏有效:

Here is the macro I have written to sort my list of employees, which works:

Sub ShuffleEmp()
' This macro's intention is to shuffle the current liste of process assessors

    Application.ScreenUpdating = False
    Dim tempString As String, tempInteger As Integer, i As Integer, j As Integer, lastRow As Integer

    ' this grabs the last row with data, so that it can be dynamic
    With Sheets("Test")
        lastRow = .Range("M" & .Rows.Count).End(xlUp).Row
    End With

    ' this assumes ALWAYS 45 tasks
    ' starting row 6, going until row 35
    For i = 6 To lastRow
        ' row 6, column 14 (next to Emp column) to start....
        Cells(i, 14).Value = WorksheetFunction.RandBetween(0, 1000)
    Next i

        'now it has assigned random values...

    For i = 6 To lastRow
        For j = i + 1 To lastRow
            '14 is the number column...
            If Cells(j, 14).Value < Cells(i, 14).Value Then

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

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

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

    Application.ScreenUpdating = True

End Sub

以下是用于将该列表转换为数组的宏:

Here is the macro for turning that list into an array:

Sub EmpArray()
' This stores the column of Emps as an array

    Dim Storage() As String ' initial storage array to take values
    Dim i As Long
    Dim j As Long
    Dim lrow As Long

    lrow = Cells(Rows.Count, "M").End(xlUp).Row ' The amount of stuff in the column

    ReDim Storage(1 To lrow - 5)

    For i = lrow To 6 Step -1
        If (Not IsEmpty(Cells(i, 13).Value)) Then ' checks to make sure the value isn't empty
            j = j + 1
            Storage(j) = Cells(i, 13).Value
        End If
    Next i

    ReDim Preserve Storage(1 To j)

    For j = LBound(Storage) To UBound(Storage)  ' loop through the previous array
        MsgBox (Storage(j))
    Next j


End Sub

推荐答案

这是您的整个程序.经过测试，可以正常工作.唯一的问题是您的屏幕截图没有显示行标题和列标题，因此我不得不假设任务是B列，第1行.

This is your entire program here. It's tested and works. The only problem is that your screenshot didn't show the row and column headers, so I had to assume that Task was column B, row 1.

这是您的主要子例程.这是您将按钮分配给的程序.这将自动检查您的employeeList是否未初始化(基本上为空)，并使用功能buildOneDimArr对其进行重建.

Here is your main Subroutine. This is the program that you will assign your button to. This will automatically check to see if your employeeList is uninitialized (basically empty) and rebuild it using the function buildOneDimArr.

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

这些是支持"功能，可让您的程序完成其工作:

These are the "support" functions that allow your program to do it's job:

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

您将要把所有这些放入标准模块中.

You are going to want to place all of these into a standard module.

这篇关于随机分配员工参加任务的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！