MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Gerar ID para grupo por bloco em tabela

    Compartilhe
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 5/7/2018, 15:28

    Senhores bom dia,

    tenho um form que gera automaticamente os itens de uma tabela, e nessa tabela se faz um relatório agrupado por "Bloco" exemplo,

    E12C...E13C...E14C... ai vem o problema, gostaria de que ao apertar de um botão ele gerasse uma ID para cada grupo desses blocos na tabela IDSaida, tipo assim

    E12C - 1110
    E12C - 1110
    E12C - 1110
    E12C - 1110
    E13C - 1123
    E13C - 1123
    E13C - 1123
    E13C - 1123
    E14C - 1345
    E14C - 1345
    E14C - 1345
    E14C - 1345

    no aguardo pessoal Very Happy
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 7/7/2018, 12:22

    Alguém pessoal ?

    Rolling Eyes

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 102
    Registrado : 26/11/2013

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  delsonk em 7/7/2018, 12:29

    Bom dia, Carvalho.

    Tenho um sistema que realiza a numeração automática de guias remessa, com base no código da organização para a qual o documentos será expedido, usando um critério semelhante que você pretende usar.
    Algumas questões:
    1. Quantos elementos o grupo precisa conter para ativar a geração o ID? Talvez tenha que criar uma tabela auxiliar para comparar se a quantidade de elementos de cada grupo atinge o número mínimo para ativar a geração automática;
    2. Precisa ordenar os elementos de forma ASC (via filtro SQL) para evitar erros. Vi que o seu BD usa caracteres e números (E12C) para identificar os itens e por isso quando ordenar terá que ser como texto;
    3. Qual será o ID inicial para realizar cada geração automática (sugiro que seja baseada na data (dia, mês e ano) para evitar duplicações.

    Abraço, Delson
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 7/7/2018, 12:42

    onrigado Delson pela atenção

    a quantidade de grupo não tem limites, tipo vai variar muito, desse jeito como conseguir fazer, você teria um exemplo para disponibilizar ?

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 102
    Registrado : 26/11/2013

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  delsonk em 7/7/2018, 12:49

    Public Sub Comando42_Click()
    'Caixa de mensagem
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Msg = "Este procedimento lançar? os números nas Guias de Remessa." & vbCrLf & "Antes de executar este procedimento ? necessário executar o comando n? 6. Lan?ar GU e  endere?o de DESTINO." & vbCrLf & " Deseja realmente continuar?"
    Style = vbOKCancel + vbExclamation + vbDefaultButton1
    Title = "Lançar os números nas GR!"
    Help = "DEMO.HLP"
    Ctxt = 1000
       Dim campo_1, campo_2 As String
       Dim estoque_1, estoque_2, cont As Integer
       Dim Data, strSQL As String
       Dim dbs As DAO.Database
       Dim rst As DAO.Recordset
       Set dbs = CurrentDb
       'Set rst = dbs.OpenRecordset("Tbl_expedicao")
       Set rst = dbs.OpenRecordset("Expedir")
       Set rst = dbs.OpenRecordset("Tbl_Expedicao_Consulta")
       DoCmd.OpenQuery "Tbl_Expedicao_Consulta", acViewPreview
       
       Response = MsgBox(Msg, Style, Title, Help, Ctxt)
       If Response = vbOK Then    ' O usuário escolheu OK.
       MyString = "Ok"    ' A resposta foi OK.
       DoCmd.Hourglass -1
       Data = Format(Now(), "yyyymmdd") ' & "." 'captura e formata a data atual
       
       'monta a consulta para deletar todos os dados da tabela Expedir
       DoCmd.SetWarnings False
       strSQL = "DELETE * FROM Expedir"
       DoCmd.RunSQL strSQL 'executa a exclusão dos dados antigos (zerar os dados da tabela auxiliar)
       
       'monta a consulta para inserir os dados da tabela Expedir
       strSQL = "INSERT INTO Expedir ( GU, ContarDeGU ) " & "SELECT GU, ContarDeGU FROM Tbl_Expedicao_Consulta;"
       DoCmd.RunSQL strSQL
       
       'fechar a consulta
       DoCmd.Close acQuery, "Tbl_Expedicao_Consulta"
           
       'monta a consulta atualização
       strSQL = "UPDATE Tbl_OM_Destino INNER JOIN (Expedir INNER JOIN Tbl_Expedicao ON Expedir.GU = Tbl_Expedicao.GU) ON Tbl_OM_Destino.Codom = Tbl_Expedicao.Codom SET Tbl_Expedicao.Estoque = True WHERE ((([Expedir]![ContarDeGU])>=[Qnt_Exp]) AND ((Tbl_Expedicao.Codom)<>'') AND ((Tbl_Expedicao.Expedida)=False)) OR (((DateDiff('d',[Data_BE],Date()))>59));"
       
       DoCmd.RunSQL strSQL 'executa a consulta atualização
       'fechar a consulta
       DoCmd.Close acTable, "Tbl_Expedicao_Consulta"
       
       'Novo
       Me.Filter = "tbl_Expedicao.Expedida=False and tbl_Expedicao.OM<>''" 'Filtro para verificar se não está expedida e o nome da OM não está em branco
       Me.FilterOn = True 'aplica o filtro
       Me.OrderBy = "RM,GU,Estoque" 'ordena os registros nesta sequência
       Me.OrderByOn = True 'aplica a ordenação
       campo_1 = "" 'zera a variável 1
       campo_2 = "" 'zera a variável 2
       estoque_1 = ""
       DoCmd.GoToControl "Codom"
       campo_1 = Me.GU
       campo_2 = Me.GU
       'DoCmd.GoToControl "Estoque"
       estoque_1 = Me.Estoque
       estoque_2 = Me.Estoque
       Do
         Recordset.MoveNext
         On Error GoTo Segunda_parte 'Final_Processo 'Exibe a mensagem de final
            campo_2 = Me.GU
            estoque_2 = Me.Estoque
            If estoque_1 = True And campo_2 = campo_1 Then
               If estoque_2 = False Then
                  Me.Estoque = True
               End If
            Else
               campo_1 = campo_2
               estoque_1 = estoque_2
            End If
       Loop Until rst.EOF
       'Novo
    Segunda_parte:
       Me.Filter = "tbl_Expedicao.Expedida=False and tbl_Expedicao.OM<>'' and tbl_Expedicao.Estoque=True" 'string do filtro a aplicar
       Me.FilterOn = True 'aplica o filtro
       Me.OrderBy = "RM,GU,OM" 'ordena os registros
       Me.OrderByOn = True 'aplica a ordena??o
       cont = 1 'inicia o contador
       campo_1 = "" 'zera a variável 1
       campo_2 = "" 'zera a variável 2
       
       DoCmd.GoToControl "Codom"
       Me.GR = Data & Format(cont, "000")
       campo_1 = Me.Codom
       campo_2 = Me.Codom
       Do Until rst.EOF
         Recordset.MoveNext
         On Error GoTo Final_Processo 'Exibe a mensagem de final
            campo_2 = Me.Codom
         If campo_2 = campo_1 Then
            Me.GR = CDbl(Data) & Format(cont, "000")
         Else
            cont = cont + 1
            Me.GR = CDbl(Data) & Format(cont, "000")
            campo_1 = campo_2
         End If
       Loop
    Final_Processo:
       MsgBox "Processo concluído com sucesso!!!!" 'Exibe a mensagem e encerra a aplicação.
       DoCmd.Hourglass 0
    Else  'Usou a opção Cancelar.
       MyString = "Cancel"    ' Executa o cancelamento.
       DoCmd.Close
       DoCmd.SetWarnings True
    End If
       
    End Sub
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 7/7/2018, 13:29

    Cara obrigado mesmo pela atenção, porem não estou conseguindo adaptar para o meu projeto, teria como mandar um exemplo para eu ver o código em execução, ai eu possa adaptar ao meu projeto! se não for pedir muito ?
    avatar
    tauron
    VIP
    VIP

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1051
    Registrado : 07/12/2011

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  tauron em 7/7/2018, 13:45

    A numeracao tem algum criterio, ou pode ser qualquer sequencia tipo E12C-1112, E13C-1113, E14C-1114, E20C-1120?
    Estas definicoes podem ajudar muito.
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 7/7/2018, 14:10

    Não tem critério! pode ser aleatório com 6 dígitos. colequei esse valores apenas para ilustrar a minha necessidade .

    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 102
    Registrado : 26/11/2013

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  delsonk em 7/7/2018, 15:08

    Enviando o exemplo.

    O BD utiliza o campo Codom para realizar o agrupamento e GR é o código gerado.
    Abra o Formulário Expedição e clique em no botão Gerar nº da guia de remessa para expedição para começar o procedimento.

    Está com um probleminha de entrar num loop de pois de concluir a geração das GR. Feche todo o BD e abra novamente para sair do loop.

    Bons estudos, Delson
    Anexos
    Ex_Guia_Remessa.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (111 Kb) Baixado 10 vez(es)
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 7/7/2018, 18:39

    Obrigado pela ajuda, com seu exemplo tive uma ideia para atender a minha necessidade, porem não consegui incluir essa tratativa para fazer o que eu desejo.

    o que preciso é que ele avalie o item que ele está e o abaixo dele, ai travou não estou conseguindo fazer,

    Código:
     Pirvate Sub IdAgrupado()

     Dim Rs1 As Recordset
        Dim ID As Double
        Dim ID2 As Double
                Randomize
            ID = Int(Rnd() * 999999)
          ID2 = Int(Rnd() * 999999)

      ' CurrentDb.Execute "delete from TbRelatorioPagoPorBlocoIten;"
            ''

        Set Rs1 = CurrentDb.OpenRecordset("select idsaida, bloco " & _
                                          "from TbRelatorioPagoPorBlocoIten ORDER BY bloco;", , 8)
       
        While Not Rs1.EOF
        If Rs1.Fields(1).Value <> Rs1.Fields(1).Value Then
            Rs1.Edit
                Rs1.Fields(0).Value = ID
                        Rs1.Update 'salvo
            Rs1.MoveNext
        Else
            Rs1.Edit 'vou adicionar
                Rs1.Fields(0).Value = ID2
                        Rs1.Update
            Rs1.MoveNext
        End If
       
        Wend 'fim do loop
       
        Rs1.Close: Set Rs1 = Nothing 'fecho a tabela principal

     


    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 102
    Registrado : 26/11/2013

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  delsonk em 9/7/2018, 20:10

    Boa tarde,

    Vou descrever uma forma de construir o algoritmo para fazer o procedimento que você quer no seu sistema.
    1. passo: odenar de forma crescente os campos que serão utilizados para fazer o agrupamento (esse procedimento é obrigatório. Caso contrário, campos iguais irão receber códigos de agrupamento diferentes);
    2. passo: vai para o início do arquivo e a variável ID recebe o primeiro item para comparação (ex: ABC) e escreve o primeiro código do agrupamento campo_do_agrupamento  (exemplo usando o ano, mês e data de hoje, separados por ponto e mais três dígitos: 2018.07.09.001);
    3. passo: vai para o próximo registro e a variável ID2 recebe o segundo item para comparação(ex: ABC) e compara se é igual à variável ID; caso for igual, escreve o mesmo código de agrupamento (ex: 2018.07.09.001) e segue para o terceiro item e assim em diante; caso for diferente (ex: ABD), a variável ID recebe a variável ID2 e adiciona uma unidade ao código do agrupamento (ex: 2018.07.09.002). E prossegue assim até o final do arquivo.

    Abraço, Delson
    avatar
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 131
    Registrado : 19/01/2013

    Re: [Resolvido]Gerar ID para grupo por bloco em tabela

    Mensagem  Carvalho em 14/7/2018, 23:20

    Muito obrigado a todos pela ajuda, também com ajuda do nosso amigo Avelino que me forneceu o código abaixo,

    Tópico resolvido.

    cheers

    Código:
    Private Sub Comando0_Click()
    Dim rs As DAO.Recordset
    Dim strSql$
    Dim uid&
    Dim cod$
    Dim Rn As Double 'alterado aqui
      Randomize  'alterado aqui
        Rn = Int(Rnd() * 99999) 'alterado aqui

        CurrentDb.Execute "Update tblteste SET Id = 0" 'alterado aqui
       
    'retorna com o recordset, somente dos registros sem o ID
    strSql = "SELECT Codigo,ID FROM tblTeste WHERE id =0 ORDER BY Codigo;"
    'Abre o recordset
    Set rs = CurrentDb.OpenRecordset(strSql)
    'captura o último ID lançado
    uid = DMax("id", "tblTeste")
    'percorrer os registros para numerar o ID
    Do While Not rs.EOF
        'verifica se mudou o código para acrecentar 1 ao ID
        If cod <> rs!codigo Then
        uid = uid + Rn 'alterado aqui
            cod = rs!codigo
        End If
        'atualiza a tabela com o novo ID
        rs.Edit
            rs!id = uid
        rs.Update
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    MsgBox "Tabela Atualizada...", vbInformation, "Aviso"
    DoCmd.OpenTable "tblTeste"
    End Sub

      Data/hora atual: 16/11/2018, 04:20