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]cruzamento e preenchimento de campos em tabelas

    Compartilhe

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 135
    Registrado : 19/10/2016

    [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Carlao2 em Qui 07 Dez 2017, 10:54

    Srs. do Conselho. Bom dia.
    Mais uma vez venho recorrer ao conhecimento dos senhores, para, conseguir elucidar um empasse.
    Tenho duas tabelas
    Princ
    Fis
    Nelas existem três campos
    Ptr
    Cnc
    Idp
    O que pretendo é o seguinte
    Um módulo que cruze as duas tabelas usando o campo Ptr
    e aonde existir o cruzamento de 1 Ptr da tabela Princ com 1 Ptr da tabela Fis o campo Idp seja preenchido com M1 nas duas tabelas
    Onde existir o cruzamento de 1 Ptr da tabela Princ com 2 ou mais Ptr da tabela Fis o campo Idp seja preenchido com B3 na tabela Princ e I3 na tabela Fis
    Onde na tabela Princ o campo Cnc estiver preenchido com Dev* o campo Idp seja preenchido com M0
    Onde na tabela Princ o campo Cnc estiver preenchido com Sobr o campo Idp seja preenchido com B1
    Onde na tabela Fis o campo Ptr estiver nulo e o campo Cnc estiver preenchido com Sobr o campo Idp seja preenchido com I1.
    Abaixo um exemplo visual

    Tabela Princ

    Ptr Cnc Idp
    0001 x M1
    0005 x M1
    0008 x B3
    0015 x B3
    0018 Sobr B1
    0035 Sobr B1
    0048 Dev S M0
    0055 DevJ M0


    Tabela Fis

    Ptr Cnc Idp
    0001 x M1
    0005 x M1
    0008 x I3
    0008 x I3
    0015 x I3
    0015 x I3
    0015 x I3
    nulo Sobr I1
    nulo Sobr I1
    nulo Sobr I1

    Desde já agradeço imensamente a atenção e se possível a ajuda para mais esse caso

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 135
    Registrado : 19/10/2016

    Re: [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Carlao2 em Qui 07 Dez 2017, 16:14

    Srs. Boa tarde
    Anexo arquivo mara maior entendimento.

    Grato
    Anexos
    exomplocruzaepreenchecampo.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (19 Kb) Baixado 5 vez(es)
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6548
    Registrado : 05/11/2009

    Re: [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Alexandre Neves em Qui 07 Dez 2017, 17:50

    Veja
    Código:
    Sub PreenchePtr()
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim Rst As DAO.Recordset, Rst1 As DAO.Recordset, strPtr As String, ContaPtr As Integer
       
        Set Rst = CurrentDb.OpenRecordset("SELECT * FROM Princ LEFT JOIN Fis ON Princ.Ptr=Fis.Ptr ORDER BY Princ.Ptr")
        Do While Not Rst.EOF
            If Rst.AbsolutePosition = 0 Then
                strPtr = Rst("Princ.Ptr")
                ContaPtr = 1
            Else
                If Rst("Princ.Ptr") = strPtr Then
                    ContaPtr = ContaPtr + 1
                Else
                    If ContaPtr = 1 Then
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Princ WHERE Ptr='" & strPtr & "'")
                        Rst1.Edit
                        Rst1("Idp") = "M1"
                        Rst1.Update
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                        If Not Rst1.EOF Then
                            Rst1.Edit
                            Rst1("Idp") = "M1"
                            Rst1.Update
                        End If
                    Else
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Princ WHERE Ptr='" & strPtr & "'")
                        Do While Not Rst1.EOF
                            Rst1.Edit
                            Rst1("Idp") = "B3"
                            Rst1.Update
                            Rst1.MoveNext
                        Loop
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                        Do While Not Rst1.EOF
                            Rst1.Edit
                            Rst1("Idp") = "B3"
                            Rst1.Update
                            Rst1.MoveNext
                        Loop
                    End If
                    strPtr = Rst("Princ.Ptr")
                    ContaPtr = 1
                End If
            End If
            Rst.MoveNext
        Loop
        Set Rst = Nothing
        Set Rst1 = Nothing
       
        CurrentDb.Execute "UPDATE Princ SET Idp='M0' WHERE Cnc='Dev'"
        CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc='Sobr'"
        CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobr'"
    End Sub


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 135
    Registrado : 19/10/2016

    Re: [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Carlao2 em Qui 07 Dez 2017, 18:06

    Alexandre. Boa tarde.
    Mais uma vez, muito obrigado pela pronta e perfeita ajuda.
    Só um detalhe na tabela Princ os itens que estão com preenchimento de DEV* na coluna cnc ele está preenchendo a coluna Idp com M1
    E o M1 só é preenchido quando há o cruzamento de 1 Ptr da tabela Princ com 1 Ptr da tabela Fis
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6548
    Registrado : 05/11/2009

    Re: [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Alexandre Neves em Qui 07 Dez 2017, 18:52

    Não tinha reparado no asterisco
    Veja
    Código:
    Sub PreenchePtr()
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess  '
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim Rst As DAO.Recordset, Rst1 As DAO.Recordset, strPtr As String, ContaPtr As Integer
       
        Set Rst = CurrentDb.OpenRecordset("SELECT * FROM Princ LEFT JOIN Fis ON Princ.Ptr=Fis.Ptr ORDER BY Princ.Ptr")
        Do While Not Rst.EOF
            If Rst.AbsolutePosition = 0 Then
                strPtr = Rst("Princ.Ptr")
                ContaPtr = 1
            Else
                If Rst("Princ.Ptr") = strPtr Then
                    ContaPtr = ContaPtr + 1
                Else
                    If ContaPtr = 1 Then
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Princ WHERE Ptr='" & strPtr & "'")
                        Rst1.Edit
                        Rst1("Idp") = "M1"
                        Rst1.Update
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                        If Not Rst1.EOF Then
                            Rst1.Edit
                            Rst1("Idp") = "M1"
                            Rst1.Update
                        End If
                    Else
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Princ WHERE Ptr='" & strPtr & "'")
                        Do While Not Rst1.EOF
                            Rst1.Edit
                            Rst1("Idp") = "B3"
                            Rst1.Update
                            Rst1.MoveNext
                        Loop
                        Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                        Do While Not Rst1.EOF
                            Rst1.Edit
                            Rst1("Idp") = "B3"
                            Rst1.Update
                            Rst1.MoveNext
                        Loop
                    End If
                    strPtr = Rst("Princ.Ptr")
                    ContaPtr = 1
                End If
            End If
            Rst.MoveNext
        Loop
        Set Rst = Nothing
        Set Rst1 = Nothing
       
        CurrentDb.Execute "UPDATE Princ SET Idp='M0' WHERE Cnc like 'Dev*'"
        CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc='Sobr'"
        CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobr'"
    End Sub


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 135
    Registrado : 19/10/2016

    Re: [Resolvido]cruzamento e preenchimento de campos em tabelas

    Mensagem  Carlao2 em Qui 07 Dez 2017, 19:09

    Alexandre
    Está perfeito

    Muito obrigado pela valiosa ajuda.

    Até uma próxima e boa tarde.



      Data/hora atual: Sex 15 Dez 2017, 23:21