Данные таблицы фильтра Excel соответствуют требованиям выборки

Мне нужно получить 2 случайных случая для каждого обработчика жалоб в таблице данных, которые можно использовать для выборки.

Таблица данных в Excel, содержащая все данные

Предполагая, что мне придется сгруппировать данные с использованием идентификатора обработчика (уникальная ссылка для каждого обработчика жалоб), а затем каким-то образом выбрать две случайные части информации из групп.

Поворот таблицы с использованием идентификатора обработчика

Я сгруппировал эту информацию с помощью Pivot. Все обработчики дел в этом случае имеют 2 или менее случаев, поэтому никаких дальнейших действий с ними не требуется. Тем не менее, у Криса Смита (h238) есть исключение, так как у него есть три случая, и максимальная выборка составляет 2 на обработчик случаев.

Мне нужен скрипт, который выберет два случайных случая для Криса и удалит все дополнительные случаи (поэтому у нас есть случайная выборка из 2 случаев).

Я могу сделать это вручную, отфильтровав таблицу по кейсам Криса, а затем удалив кейсы, пока не останется только два. Однако фактический набор данных будет намного больше, поэтому он будет очень трудоемким, и этот процесс необходимо запускать несколько раз в день, а данные в таблице постоянно меняются.

Всего 1 ответ


Это интересный!

Вот мое решение. Я перепробовал несколько возможных версий.
Попробуйте 1:
Согласно первоначально опубликованным данным - Крис Смит (h238) перегружен 1 задачей, и для переназначения задач достаточно людей: try1 Попробуйте 2:
Крис Смит (h238) по-прежнему перегружен, но на этот раз с 3 задачами и достаточно людей, чтобы переназначить задачи: try2 Попробуйте 3:
Бедный Крис Смит (h238) полностью перегружен, но на этот раз не хватает людей, чтобы переназначить задачи: try3 Попробуйте 4: На этот раз Джейн Доу (h324) соответствует Крису Смиту (h238) - они перегружены, но не хватает людей для переназначения задач: try4

Случаи, когда нет перегруженных или свободных людей ломаются с соответствующими сообщениями, не делали скриншота.
Код:

Sub ReassignCases()
' Variables
' people  related:
Dim handlerIdRange As Range, handlerId As Range
Dim maxCases As Long
Dim cases As Long
Dim name As String, id As String
Dim nameTo As String, idTo As String
Dim caseRef As Range

' arrays:
Dim overloaded() As String
Dim free() As String

' counters:
Dim o As Long, f As Long, i As Long, c As Long, j As Long

' unique values container
Dim handlersList As New Collection

' output
Dim msg As String

Dim workSht As Worksheet

'----------------------------------------------------
' reassign the sheet name as you have in your workbook
Set workSht = ThisWorkbook.Sheets("Sheet1")

' parameter that can be changed if needed
maxCases = 2

With workSht
    Set handlerIdRange = Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
    Set handlerNameRange = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

' get the list of handlers
On Error Resume Next
For Each handlerId In handlerIdRange
    handlersList.Add handlerId & ";" & handlerId.Offset(0, -1), handlerId & ";" & handlerId.Offset(0, -1)
Next
Err.Clear
On Error GoTo 0

For i = 1 To handlersList.Count

    ' look for overloaded
    If Application.WorksheetFunction.CountIf(handlerIdRange, Split(handlersList(i), ";")(0)) > maxCases Then
        ReDim Preserve overloaded(o)
        ' adding to array: id;name;qty of cases
        overloaded(o) = handlersList.Item(i) & ";" & Application.WorksheetFunction.CountIf(handlerIdRange, Split(handlersList(i), ";")(0))
        o = o + 1
    ' look for those who has less the 2 cases. If one has 2 cases - he is not free
    ElseIf Application.WorksheetFunction.CountIf(handlerIdRange, Split(handlersList(i), ";")(0)) < maxCases Then
        ReDim Preserve free(f)
        free(f) = handlersList.Item(i)
        f = f + 1
    End If
Next

' check whether there are overloaded handlers
If Not Not overloaded Then
    ' if yes - proceed further
    Else
    ' if not - inform and quit
    MsgBox "There are no overloaded handlers.", vbInformation, "Info"
    Exit Sub
End If

' check whether there are free handlers
If Not Not free Then
    ' if yes - proceed further
    Else
    ' if not - inform and quit
    o = UBound(overloaded) + 1
    MsgBox "There " & IIf(o = 1, "is ", "are ") & o & " overloaded " & IIf(o = 1, "handler", "handlers") & ", but 0 free.", vbInformation, "Info"
    Exit Sub
End If
msg = ""
' go through array of overloaded
For i = LBound(overloaded) To UBound(overloaded)
    ' Id of overloaded
    id = Split(overloaded(i), ";")(0)
    ' Name of overloaded
    name = Split(overloaded(i), ";")(1)
    ' number of over cases = total assigned - 2 (max cases)
    cases = Split(overloaded(i), ";")(2) - maxCases
    '

    ' check that there some free people left
    If Not c > UBound(free) Then
    ' go through each handler in the array of free people
    ' free people are those, who have only 1 task and can take another 1

    ' if c was not used yet it is 0, otherwise, it will continue looping through free people
        For c = c To UBound(free)

            idTo = Split(free(c), ";")(0)
            nameTo = Split(free(c), ";")(1)

            ' find the first match of the id in Id range
            Set caseRef = handlerIdRange.Find(what:=id, LookIn:=xlValues)
            ' give an outcome of what was reassigned
            msg = msg & "Task: " & caseRef.Offset(0, 1).Text & " was reassigned from " & name & " (" & id & ") "
                With caseRef
                    .Value = idTo
                    .Offset(0, -1).Value = nameTo
                End With
            msg = msg & "to " & nameTo & " (" & idTo & ")" & Chr(10)
            cases = cases - 1
            ' when all needed cases are passed to other people - stop looking through free people, proceed to next overloaded
            If cases = 0 Then Exit For
        Next
        ' if the loop through free people is finished,
        ' but there left some more cases - go to warning creation
        If Not cases = 0 Then GoTo leftCases
    Else
leftCases:
        msg = msg & Chr(10) & Chr(10) & "There are no more free handlers." & Chr(10)

        For j = i To UBound(overloaded)
            msg = msg & Split(overloaded(j), ";")(1) & " is still overloaded with " & cases & " cases." & Chr(10)
        Next

        msg = msg & Chr(10) & "Operation completed with warnings."
        MsgBox msg, vbExclamation, "Done"
        Exit Sub
    End If
Next

msg = msg & Chr(10) & "Operation completed."

MsgBox msg, vbInformation, "Done"

End Sub

Заметка
1. Я не рандомизировал список свободных людей, поэтому их берут по одному. Если вам это нужно - вы можете легко найти макрос для рандомизации массива и вставить его в качестве побочной функции.
2. Я не уверен, что это работает отлично - комментарии приветствуются!


Есть идеи?

10000