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]segundo e último bloco de cruzamento e preenchimento de tabela

    Compartilhe

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 11/12/2017, 11:36

    Srs. do conselho. Bom dia
    Abri, recentemente um tópico desse assunto que foi prontamente respondido pelo amigo Alexandre Neves
    que me passou esse 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

    Porém tenho uma segunda fase que fecha esse circulo, ficando assim totalmente automatizado e seria ótimo se algum dos senhores pudessem me ajudar.

    Explicando essa segunda fase

    Após ele executar o módulo acima, ele teria que proceder da seguinte forma:

    Esse processo deverá ocorrer somente na tabela Princ.

    Para os itens onde o PtrAlt é igual ao Ptr e lá encima ele preencheu a coluna Idp com "M1", esses deverão ser preenchidos a coluna Idp com "B2"
    Para os itens onde o Ptralt é igual ao Ptr e lá encima ele preencheu a coluna Idp com "B3", esses deverão ser preenchidos a coluna Idp com "I4"
    Para os itens onde o PtrAlt é igual ao Ptr e lá encima ele preencheu a coluna Idp com "M0", esses deverão ser preenchidos a coluna Idp com "B2"

    Anexo o exemplo para maior entendimento

    Desde já agradeço imensamente a ajuda dos senhores
    Anexos
    exomplocruzaepreenchecampo.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (29 Kb) Baixado 7 vez(es)

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 27/12/2017, 13:15

    Srs. do Conselho. Bom dia
    Desejo à todos um ano novo repleto de saúde, paz, felicidades e que tenham seus sonhos plenamente realizados

    Alguém poderia, por favor me ajudar com esse problema?

    Desde já fico muito agradecido
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 7/1/2018, 14:56

    Boa tarde,
    Agradeço e retribuo os votos de Feliz Ano 2018
    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'"
       
        CurrentDb.Execute "UPDATE Princ SET Idp='B2' WHERE PtrAlt=Ptr and Idp='M1'"
        CurrentDb.Execute "UPDATE Princ SET Idp='I4' WHERE PtrAlt=Ptr and Idp='B3'"
        CurrentDb.Execute "UPDATE Princ SET Idp='B2' WHERE PtrAlt=Ptr and Idp='M0'"
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 8/1/2018, 11:09

    Grande Alexandre. Bom dia

    Está quase perfeito, senão pelo fato de que eu talvez não tenha me expressado da forma correta.
    Abaixo tentarei fazer um exemplo mais claro

    Tbl_Princ

    Ptr PtrAlt Cnc Idp

    10 10 qualquer preenchimento M1
    18 18 qualquer preenchimento M1
    15 15 qualquer preenchimento B3
    60 60 qualquer preenchimento B3
    25 25 Dev* M0
    32 32 Dev* M0
    40 40 Sobra* B1
    42 42 Sobra* B1
    43 10 qualquer preenchimento B2
    50 18 qualquer preenchimento B2
    53 15 qualquer preenchimento I4
    72 60 qualquer preenchimento I4







    Tbl_Fis

    Ptr Cnc Idp

    10 qualquer preenchimento M1
    18 qualquer preenchimento M1
    15 qualquer preenchimento I3
    15 qualquer preenchimento I3
    I5 qualquer preenchimento I3
    60 qualquer preenchimento I3
    60 qualquer preenchimento I3
    Null Sobra* I1
    Null Sobra* I1


    Vou tentar explicar o acima exposto



    Ptr = PtrAlt e na Tbl_fis tenha um Ptr Idp = M1 nas duas Tbls
    Ptr = PtrAlt Onde na Tbl_Fis tenha mais de um Ptr Idp = B3 Na Tbl_princ e I3 na Tbl_Fis
    Ptr = Null e Cnc = Sobra* na Tbl_Fis Idp = I1
    Ptr = PtrAlt e Cnc = Dev* na Tbl_Princ Idp = M0
    Ptr = PtrAlt e Cnc = Sobra* na Tbl_Princ Idp = B1

    Somente na Tbl_Princ

    Ptr <> PtrAlt onde acima ele preencheu com M1 Idp = B2
    Exemplo

    Ptr PtrAlt Idp
    10 10 M1
    43 10 B2

    Veja que para o PtrAlt ele é iqual ao M1 mas o Ptr é diferente

    Ptr <> PtrAlt onde acima ele preencheu com B3 Idp = I4
    Exemplo

    Ptr PtrAlt Idp
    15 15 B3
    53 15 I4

    Veja que para o PtrAlt ele é iqual ao B3 mas o Ptr é diferente

    Espero ter conseguido explicar de maneira clara

    E desde já agradecendo pela força

    Abraços







    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 8/1/2018, 19:26

    Boa noite,

    Veja se funciona
    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"
                      if Rst1("PtrAlt") = Rst1("Ptr") then Rst1("Idp") = "B2"
                      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"
                          if Rst1("PtrAlt") = Rst1("Ptr") then Rst1("Idp") = "I4"
                          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='B2' WHERE PtrAlt=Ptr and 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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 8/1/2018, 19:43

    Alexandre Boa Noite.

    Muito obrigado pelo retorno

    Ainda não está a funcionar.
    O preenchimento da Tbl_Fis está correto, já o da Tbl_Princ está errado

    Estou anexando o BD com o módulo que você me passou e criei na Tbl_Princ uma Coluna com o Idp correto
    Por favor, de uma analisada e veja se consegue resolver
    Anexos
    exomplocruzaepreenchecampo.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (27 Kb) Baixado 3 vez(es)
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 8/1/2018, 20:58

    Voltando à primeira versão do código
    Explique o que pretende alterar


    .................................................................................
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 9/1/2018, 10:08

    Bom dia Alexandre

    A primeira fase do módulo está perfeita.
    Porém imagine que tenho na Tbl_Princ o Ptr 10 e o PtrAlt 10 e na Tbl_Fis a quantidade de um Ptr 10
    Então o módulo coloca na coluna Idp a informação de "M1" nas duas tabelas, o que está perfeito
    Outra situação á na Tbl_Princ tenho o Ptr 15 e o PtrAlt 15 e na Tbl_Fis a quantidade de quatro Ptr 15
    Então o módulo coloca na coluna Idp da Tbl_Princ a informação "B3" e na Tbl_Fis a informação "I3"

    Agora a alteração que preciso

    Na Tbl_Princ imagine que tenho o Ptr 25 e PtrAlt 10 no item onde tinha Ptr 10 e PtrAlt 10 ele preencheu com "M1", e esse ele deverá preencher com "B2"
    Na Tbl_Princ imagine que tenho o Ptr 30 e PtrAlt 10 no item onde tinha Ptr 10 e PtrAlt 10 ele preencheu com "M1", e esse ele deverá preencher com "B2"

    e

    Na Tbl_Princ imagine que tenho o Ptr 40 e PtrAlt 15 no item onde tinha Ptr 15 e PtrAlt 15 ele preencheu com "B3", e esse ele deverá preencher com "I4"
    Na Tbl_Princ imagine que tenho o Ptr 25 e PtrAlt 15 no item onde tinha Ptr 15 e PtrAlt 15 ele preencheu com "B3", e esse ele deverá preencher com "I4"

    Veja que para essa etapa do módulo ele deverá ser amarrado pelo PtrAlt pois o Ptr é diferente

    Espero ter sido claro em minha explicação

    E mais uma vez agradeço o seu empenho em ajudar-me


    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 11/1/2018, 14:44

    Boa tarde,
    Veja se é isto
    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
                      If Rst1("PtrAlt") = Rst1("Ptr") Then Rst1("Idp") = "M1" Else Rst1("Idp") = "B2"
                      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
                          If Rst1("PtrAlt") = Rst1("Ptr") Then Rst1("Idp") = "B3" Else Rst1("Idp") = "I4"
                          Rst1.Update
                          Rst1.MoveNext
                      Loop
                      Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                      Do While Not Rst1.EOF
                          Rst1.Edit
                          Rst1("Idp") = "I3"
                          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='B2' WHERE PtrAlt=Ptr and Cnc like 'Dev*'"
      CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc like 'Sobr*'"
      CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobra'"
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 11/1/2018, 16:11

    Boa Tarde Alexandre
    Não me canso de agradecer seu empenho em me ajudar, muito obrigado
    Mas ele ainda não está funcionando corretamente.
    Copiei as tabelas após executar o módulo e veja o resultado

    A tebela fis está correta


    Ptr Cnc Idp
    0000001 TT M1
    0000002 LL M1
    0000010 CC M1
    0000015 CC4 I3
    0000018 CC5 I3
    0000020 GG M1
    Sobra I1
    Sobra I1
    0000015 CC4 I3
    0000015 CC4 I3
    0000015 CC4 I3
    0000018 CC5 I3
    0000018 CC5 I3
    0000018 CC5 I3
    0000018 CC5 I3
    Sobra I1


    Já a tabela Princ está com alguns erros,
    Coloquei ao lado da coluna IDP o IDP correto que deveria ser preenchido
    Espero que isso te ajude a entender o processo

    Ptr Cnc Idp IdpCorreto PtrAlt
    0000001 TT M1 OK 0000001
    0000002 LL M1 OK 0000002
    0000010 CC M1 OK 0000010
    0000015 CC4 B3 OK 0000015
    0000018 CC5 B3 OK 0000018
    0000020 GG M1 OK 0000020
    0001256 Sobra B1 OK 0001256
    0001625 Sobra-mesmo B1 OK 0001625
    0002356 dev B2 M0 0002356
    0003256 dev-djdj B2 M0 0003256
    0012525 dev-susu B2 M0 0012525
    0000009 TT B2 OK 0000001
    0096547 CC4 B2 I4 0000015
    0754548 CC B2 OK 0000010
    0365212 CC5 B2 I4 0000018
    7454121 dev M0 B2 0002356

    Grato
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 11/1/2018, 18:22

    Vamos por partes
    Vamos tratar onde fica M0 e devia ficar B2
    No 1º código, coloca-se IDP=M0 na tabela Princ onde CnC começa por Dev

    devemos colocar IDP=M0 na tabela Princ onde CnC começa por Dev e PTR diferente de PTRALT?
    devemos colocar IDP=B2 na tabela Princ onde CnC começa por Dev e PTR igual a PTRALT?


    .................................................................................
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 11/1/2018, 19:32

    Alexandre

    Coloca-se IDP = M0 na Tabl Princ onde o PTR = PTRALT e CNC começa por DEV
    Coloca-se IDP = B2 na Tabl Princ onde o PTR <> PTRALT e CNC começa por DEV ou SOBRA
    Coloca-se IDP = B1 na Tabl Princ onde o PTR = PTRALT e CNC começa por SOBRA
    Coloca-se IDP = M1 na tabl Princ e na Tbl Fis onde o PTR = PTRALT e existe somente 1 PTR na Tabl Fis
    Coloca-se IDP = B3 na Tabl Princ e I3 na Tbl Fis onde o PTR = PTRALT e existe mais de 1 PTR na Tabl Fis
    Coloca-se IDP = I1 na Tabl Fis onde o PTR for Nulo

    Agora vem a parte complicada

    Se voce tem um item na Tbl Princ onde o PTR <> PTRALT mas o PTRALT existe na Tabl Fis e lá foi colocado M1
    para esse item na Tbl Princ o IDP = B2 independente do que estiver no CNC

    Se voce tem um item na Tbl Princ onde o PTR <> PTRALT mas o PTRALT existe na Tabl Fis e lá foi colocado I3
    para esse item na Tbl Princ o IDP = I4 independente do que estiver no CNC

    Acho que assim como você colocou a pergunta fica mais fácil entender a resposta que coloquei aqui.

    Grato


    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 13/1/2018, 13:41

    Boa tarde,
    veja agora
    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
                      If Rst1("PtrAlt") = Rst1("Ptr") Then Rst1("Idp") = "M1" Else Rst1("Idp") = "B2"
                      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
                          If Rst1("PtrAlt") = Rst1("Ptr") Then Rst1("Idp") = "B3" Else Rst1("Idp") = "I4"
                          Rst1.Update
                          Rst1.MoveNext
                      Loop
                      Set Rst1 = CurrentDb.OpenRecordset("SELECT * FROM Fis WHERE Ptr='" & strPtr & "'")
                      Do While Not Rst1.EOF
                          Rst1.Edit
                          Rst1("Idp") = "I3"
                          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='B2' WHERE PtrAlt=Ptr and Cnc like 'Dev*'"
      CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc like 'Sobr*'"
      CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobra'"
     
      CurrentDb.Execute "UPDATE Princ LEFT JOIN Fis ON Princ.PtrAlt=Fis.Ptr SET Princ.Idp='B2' WHERE Princ.Ptr<>Princ.PtrAlt and Fis.Idp='M1'"
      CurrentDb.Execute "UPDATE Princ LEFT JOIN Fis ON Princ.PtrAlt=Fis.Ptr SET Princ.Idp='I4' WHERE Princ.Ptr<>Princ.PtrAlt and Fis.Idp='I3'"
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 15/1/2018, 10:29

    Alexandre. Muito Bom dia

    Está quase perfeito.

    O único procedimento que ele não está fazendo de forma correta é esse

    Coloca-se IDP = B2 na Tabl Princ onde o PTR <> PTRALT e CNC começa por DEV ou SOBRA

    ele está colocando no IDP M0

    E o M0 deve ser colocado somente onde PTR=PTRALT e CNC começando por DEV.

    Mais uma vez agradeço muito sua ajuda


    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 15/1/2018, 10:39

    Alexandre

    Fiz essa alteração e parece-me que agora está funcionando

    CurrentDb.Execute "UPDATE Princ SET Idp='M0' WHERE Cnc like 'Dev*'"
    CurrentDb.Execute "UPDATE Princ SET Idp='M0' WHERE PtrAlt=Ptr and Cnc like 'Dev*'"
    CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc like 'Sobr*'"
    CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobra'"
    CurrentDb.Execute "UPDATE Princ SET Idp='B2' WHERE PtrAlt<>Ptr and Cnc like 'Dev*'"
    CurrentDb.Execute "UPDATE Princ SET Idp='B2' WHERE PtrAlt<>Ptr and Cnc like 'Sobra*'"

    Acredito que a primeira linha eu possa eliminar sem nenhum problema. Correto?

    Grato
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Alexandre Neves em 15/1/2018, 20:13

    Boa noite,
    Pode eliminar a segunda porque o que for alterado pela segunda, já foi alterado pela primeira
    Se as instruções que indicou funcionam, pode melhorar assim
    CurrentDb.Execute "UPDATE Princ SET Idp='M0' WHERE Cnc like 'Dev*'" ' eliminada segunda instrução
    CurrentDb.Execute "UPDATE Princ SET Idp='B1' WHERE Cnc like 'Sobr*'"
    CurrentDb.Execute "UPDATE Fis SET Idp='I1' WHERE IsNull(Ptr) and Cnc='Sobra'"
    CurrentDb.Execute "UPDATE Princ SET Idp='B2' WHERE PtrAlt<>Ptr and (Cnc like 'Dev*' or Cnc like 'Sobra*')" ' junta as duas últimas instruções


    .................................................................................
    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 : 171
    Registrado : 19/10/2016

    Re: [Resolvido]segundo e último bloco de cruzamento e preenchimento de tabela

    Mensagem  Carlao2 em 16/1/2018, 10:20

    Alexandre. Bom dia

    Sua informação foi perfeita.
    Agora está a funcionar sem problemas

    Mais uma vez agradeço o seu empenho em ajudar-me a resolver essa questão


    Grato


      Data/hora atual: 21/7/2018, 14:35