[Resolvido]cruzamento e preenchimento de campos em tabelas

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

Srs. Boa tarde
Anexo arquivo mara maior entendimento.

Grato

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


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

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


Alexandre
Está perfeito

Muito obrigado pela valiosa ajuda.

Até uma próxima e boa tarde.