[Resolvido]Distribuição igualitária e automática

Boa Noite pessoal.

Pesquisei no fórum, mas não encontrei solução para o problema com que estou me deparando:

Possuo uma tabela "tbl_demandas" com os campos "num_demanda" (chave primária) e "responsavel_demanda" (campo vazio que receberá o nome de um funcionário da tabela "tbl_funcinoarios".

A tabela "tbl_funcionarios" possui os campos "cod_funcionario" (chave primaria) e "nome funcionário" (dado que preencherá os campo "responsavel_demanda" com valores vazios da tabela "tbl_demandas".

Também tenho um formulário contínuo chamado "distribuição" que seleciona apenas os registros cujo campo "responsável demanda" for nulo.

Preciso que o formulário leia o nome dos empregados cadastrados uma tabela "tbl_funcionarios" e preencha de forma igualitária o campo "responsável demanda" com valores vazios com o nome desses empregados. Por exemplo:

Em um determinado dia, recebemos algumas tarefas para distribuição. No formulário de distribuição, o programa deve verificar a quantidade de funcionários contidos na tabela "tbl_funcionarios", dividir pelo total de demandas sem responsável na tabela "tbl_demandas" e se o resto for 0, a divisão deverá ser igualitária, se houver resto, a diferença deverá ser distribuída aleatoriamente entre a lista de funcionários.

No caso fictício acima, se a quantidade de demandas na tabela "tbl_demandas" for 100 e se a quantidade de funcionários na tabela "tbl_funcionarios" for 5, o resto será 0 e cada funcionário receberá 20 demandas de forma aleatória. Se a quantidade de funcionários for 8, o resto será 4 e cada um dos funcionários receberá 12 demandas sendo que as 4 restantes serão distribuídas aleatoriamente.

Pensei em criar um botão no formulário de distribuição para efetuar toda a operação na tabela "tbl_demandas".

Desde já agradeço a ajuda.

Abraços.

Boas amigo, seja bem vindo ao Fórum!

Ajudaria se postasse um exemplo para que possamos ver isto pra ti.

Cumprimentos.

Piloto,

Obrigado pelas boas vindas!

Segue o banco de exemplo.

Pretendo que ao acionar o botão "distribuição" o formulário veja quantas demandas estão sem responsável na tabela de demandas e distribua os nomes dos responsáveis com base nos funcionários cadastrados na tabela "funcionários".

Desde já agradeço a sua ajuda

Distribuir as demandas em branco pelos funcionarios X Demandas / X Funcionarios...

Isto:


Cumprimentos.

Isso mesmo, Piloto!

Preciso preencher os campos em branco com o nome dos funcionários de forma que a distribuição seja a mais igualitária possível.

Agradeço antecipadamente caso consiga me ajudar nessa.

O Código para isso:

Private Sub btDistribuir_Click()
'Declaração de variáveis
Dim Rs As DAO.Recordset
Dim RsFunc As DAO.Recordset
Dim StrSQL As String
Dim StrSQFunc As String
Dim Looping As Boolean
'Carrego as variáveis com as SQL's das respectivas tabelas
StrSQL = "SELECT * FROM tbl_Demandas WHERE Responsavel_Demanda Is Null"
StrSQLFunc = "SELECT * FROM tbl_Funcionarios"

'Carrego os recordset's com as SQL's
Set Rs = CurrentDb.OpenRecordset(StrSQL)
Set RsFunc = CurrentDb.OpenRecordset(StrSQLFunc)

'Movo o Rs para o o primeiro registro
Rs.MoveFirst
'Este rótulo será ativado para quando chegar ao registro do último funcionario, assim define a varivel Looping(tipo boolean) com false
'para permitir a continuidade de loop pelos funcionarios
Continuar:
'Se a variável estiver definida como verdadeira, define-a como falsa e move o RsFunc para o primeiro registro
If Looping = True Then
    Looping = False
    RsFunc.MoveFirst
End If
'Faço o loop pela tabela funcionarios
Do While Not RsFunc.EOF
        'Abro a edição do Recordset baseado na tbl_Demandas
        Rs.Edit
        'Atualizo o campo com o nome do funcionário
        Rs(1) = RsFunc(1)
        'Atualiza o recordset
        Rs.Update
        'Movo o registro para a próxima demanda
        Rs.MoveNext
'Movo o registro para o próximo funcionário
RsFunc.MoveNext
        'Checo se chegou ao último funcionário, caso sim
        'Defino a variável Looping para Verdadeiro e vou para o Rótulo continuar
        'Assim continuo a inserir o primeiro funcionário na próxima demanda vaga
        If RsFunc.EOF Then
            Looping = True
            GoTo Continuar
        End If
Loop
End Sub

cumprimentos.

Sensacional, Piloto!

Só ocorre um errinho no procedimento. Quando executo o script ocorre a seguinte mensagem de erro: "Erro em tempo de execução '3021': Nenhum registro atual"

Mas quando clico em fim na janela de erro ou faço a depuração, noto que os campos foram gravados perfeitamente.

O depurador aponta para o objeto "Rs.Edit".

Ou seja, o script funciona. O chato é só a janela de erro que aparecendo. Teria como tratar esse errinho?

Este erro acontece quando chega ao fim da tabela Demandas e o proximo loop de funcionario tenta gravar o registro.

Para isto deves aplicar o tratamento de erros direcionando para o case específico.

Private Sub btDistribuir_Click()
'----------------------------------------------
'Tratamento de Erros
On Erro GoTo TrataErros
'----------------------------------------------
'Declaração de variáveis
Dim Rs As DAO.Recordset
Dim RsFunc As DAO.Recordset
Dim StrSQL As String
Dim StrSQFunc As String
Dim Looping As Boolean
'Carrego as variáveis com as SQL's das respectivas tabelas
StrSQL = "SELECT * FROM tbl_Demandas WHERE Responsavel_Demanda Is Null"
StrSQLFunc = "SELECT * FROM tbl_Funcionarios"

'Carrego os recordset's com as SQL's
Set Rs = CurrentDb.OpenRecordset(StrSQL)
Set RsFunc = CurrentDb.OpenRecordset(StrSQLFunc)

'Movo o Rs para o o primeiro registro
Rs.MoveFirst
'Este rótulo será ativado para quando chegar ao registro do último funcionario, assim define a varivel Looping(tipo boolean) com false
'para permitir a continuidade de loop pelos funcionarios
Continuar:
'Se a variável estiver definida como verdadeira, define-a como falsa e move o RsFunc para o primeiro registro
If Looping = True Then
    Looping = False
    RsFunc.MoveFirst
End If
'Faço o loop pela tabela funcionarios
Do While Not RsFunc.EOF
  'Abro a edição do Recordset baseado na tbl_Demandas
  Rs.Edit
  'Atualizo o campo com o nome do funcionário
  Rs(1) = RsFunc(1)
  'Atualiza o recordset
  Rs.Update
  'Movo o registro para a próxima demanda
  Rs.MoveNext
'Movo o registro para o próximo funcionário
RsFunc.MoveNext
  'Checo se chegou ao último funcionário, caso sim
  'Defino a variável Looping para Verdadeiro e vou para o Rótulo continuar
  'Assim continuo a inserir o primeiro funcionário na próxima demanda vaga
  If RsFunc.EOF Then
      Looping = True
      GoTo Continuar
  End If
Loop
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
    DoCmd.Hourglass False
    DoCmd.Echo True
Exit Sub
TrataErro:
    Select Case Err.Number
        Case 3021
             MsgBox "Demandas inseridas", vbInformation, "PRONTO"
              Exit Sub
        Case Else
            DoCmd.Hourglass False
            DoCmd.Echo True
                MsgBox "Erro Gerado no :" & Me.Name & " (btDistribuir_Click)" _
                & vbNewLine & "Erro Número: " & Err.Number _
                & vbNewLine & "linha: " & Erl _
                & vbNewLine & "Descrição: " & Err.Description _
                & vbNewLine & "Por favor contate o Administrador de Sistema.", vbCritical, Err.Number & ", linha:" & Erl
    End Select

Cumprimentos.

Perfeito, Piloto.

Muito obrigado. Quebras-te um galhão!

Abraços.

O fórum agradece o Retorno.