Excel EXCEL - Dividir demanda aleatoriamente

[xfabricio10]

Boa tarde,

 

Gostaria da ajuda de vocês com uma atividade que estou tentando automatizar;

 

Tenho diariamente uma lista de Tickets que deve ser atendido por 11 funcionarios, gostaria de uma macro/ formula para fazer a divisão desses Ticket de forma aleatoria;

 

No exemplo em anexo tenho uma quantidade de 2293 Ticket; (2293 dividido por 11, daria uma media de 208 Tickets para cada).

Eu estava tentando usar a formula "RANDBETWEEN", porém ela não divide em partes iguais, acaba que um sempre fica com mais do que o outro.

 

Nessa divisão tenho duas regras de exessão:

Tipo de Documento = Farm / Atomatados, vão ser colocados apenas para os Funcionarios 1 e Funcionarios 2

Tipo de Documento = AgHorizon, vão ser colocados apenas para os Funcionarios 3

 

O restante vai ser dividido em partes iguais para todos, descontando o que eles ja possuem;

Exemplo: Caso o funcionario 3 ja tenha 50 Tickets do tipo AgHorizon, ele vai receber somente mais 158, para ficar com um total de 208 (A media citada acima).

Exemplo-Divisão-Demanda.xlsx

[Visitante]

Experimente:

 

Sub DistribuiTíquetes()
 Dim LR As Long, m As Long, c As Range, i As Long
  Application.ScreenUpdating = False
  ActiveSheet.AutoFilterMode = False
  LR = Cells(Rows.Count, 1).End(3).Row
  m = Int((LR - 1) / 11) + 1
  Range("C2:C" & LR).Value = ""
  If Application.CountIf([B:B], "AgHorizon") > 0 Then
   Range("A1:C" & LR).AutoFilter 2, "AgHorizon"
   Range("C2:C" & LR).SpecialCells(xlCellTypeVisible).Value = 3
  End If
  If Application.CountIf([B:B], "Farm / Atomatados") > 0 Then
   Range("A1:C" & LR).AutoFilter 2, "Farm / Atomatados"
   Range("C2:C" & LR).SpecialCells(xlCellTypeVisible).Formula = "=MOD(ROW(A2),2)+1"
  End If
   ActiveSheet.AutoFilterMode = False
   Range("C2:C" & LR).Value = Range("C2:C" & LR).Value
    For Each c In Range("C2:C" & LR)
     If c.Value = "" Then
      Do
       i = IIf(i < 11, i + 1, 1)
       If Application.CountIf([C:C], i) < m Then Exit Do
      Loop
     c.Value = i
     End If
    Next c
  Application.ScreenUpdating = True
End Sub

 

[xfabricio10]

Em 13/09/2018 às 21:44, osvaldomp disse:

Experimente:

 

Sub DistribuiTíquetes()
 Dim LR As Long, m As Long, c As Range, i As Long
  Application.ScreenUpdating = False
  ActiveSheet.AutoFilterMode = False
  LR = Cells(Rows.Count, 1).End(3).Row
  m = Int((LR - 1) / 11) + 1
  Range("C2:C" & LR).Value = ""
  If Application.CountIf([B:B], "AgHorizon") > 0 Then
   Range("A1:C" & LR).AutoFilter 2, "AgHorizon"
   Range("C2:C" & LR).SpecialCells(xlCellTypeVisible).Value = 3
  End If
  If Application.CountIf([B:B], "Farm / Atomatados") > 0 Then
   Range("A1:C" & LR).AutoFilter 2, "Farm / Atomatados"
   Range("C2:C" & LR).SpecialCells(xlCellTypeVisible).Formula = "=MOD(ROW(A2),2)+1"
  End If
   ActiveSheet.AutoFilterMode = False
   Range("C2:C" & LR).Value = Range("C2:C" & LR).Value
    For Each c In Range("C2:C" & LR)
     If c.Value = "" Then
      Do
       i = IIf(i < 11, i + 1, 1)
       If Application.CountIf([C:C], i) < m Then Exit Do
      Loop
     c.Value = i
     End If
    Next c
  Application.ScreenUpdating = True
End Sub

 

 

Cara isso mesmo, valeu pela ajuda ficou TOP.