Excel过滤器表数据满足采样要求

Question

我需要在可用于采样的数据表中为每个投诉处理者获得2个随机案例。

“>

假设我必须使用处理程序ID（每个投诉处理程序的唯一引用）将数据分组，然后再从中选择两个随机的信息。

“ >>

我已经使用数据透视表对这些信息进行了分组。此案例中的所有案例处理程序都具有2个或更少的案例，因此无需对此采取进一步的措施。但是，克里斯·史密斯（h238）例外，因为他有3个案例，每个案例处理程序的最大采样数是2。

我需要一个脚本，该脚本将为Chris选择两个随机案例并删除所有其他案例（因此我们有2个案例的随机样本。）>

我可以通过按Chris的案例过滤表，然后删除案例直到只剩下两个案例来手动完成此操作。但是，实际数据集会大得多，因此非常耗时，并且该过程需要每天运行几次，并且表中的数据会不断变化。

我需要在可用于采样的数据表中为每个投诉处理者获得2个随机案例。假设我将不得不使用Handler ID（对每个...的唯一引用...

这很有趣！

这是我的解决方案。我已经尝试了几种可能的版本。尝试1：根据原始发布的数据-克里斯·史密斯（h238）超载了1个任务，并且有足够的人来重新分配任务：尝试2：克里斯·史密斯（Chris Smith）（h238）仍然超负荷工作，但这一次有3个任务，并且有足够的人来重新分配任务：尝试3：可怜的克里斯·史密斯（h238）完全不堪重负，但是这次没有足够的人来重新分配任务：试试4：这次Jane Doe（h324）与Chris Smith（h238）保持一致-他们超负荷工作，但是没有足够的人来重新分配任务：

没有超载或没有空闲人员打破适当消息的情况，没有进行屏幕截图。代码：

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
注意
我没有随机列出一个免费的人，所以他们是一个接一个的。如果确实需要这样做，则可以轻松地找到一个宏来随机化数组并将其作为辅助函数插入。2.我不确定它是否完美运行-感谢评论！

Answer 1

这很有趣！