MaximoAccess

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

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

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

    [Resolvido]Gerar ID para grupo por bloco em tabela

    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty [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
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty Gerar ID para grupo por bloco em tabela

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

    Alguém pessoal ?

    Rolling Eyes
    avatar
    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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 ?
    avatar
    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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 ?
    tauron
    tauron
    VIP
    VIP

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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.
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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 .
    avatar
    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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
    [Resolvido]Gerar ID para grupo por bloco em tabela AttachmentEx_Guia_Remessa.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (111 Kb) Baixado 10 vez(es)
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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

     

    avatar
    delsonk
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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
    Carvalho
    Carvalho
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]Gerar ID para grupo por bloco em tabela Empty 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: 22/10/2020, 05:23