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

    Contagem e preenchimento

    Compartilhe

    Carlao2
    Intermediário
    Intermediário

    Respeito às Regras 100%

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

    Contagem e preenchimento

    Mensagem  Carlao2 em 3/7/2018, 18:41

    Boa tarde à todos
    De novo venho recorrer a experiencia dos senhores.
    Há alguma maneira de um módulo ler o campo quantidade de uma tabela e levar essa informação para uma outra tabela.

    Explico

    Tenho a tabela FUN e nela tenho o campo "VER" que será usado para amarração com a tabela OPC.
    Pois bem. Na tabela FUN tenho um determinado VER com quantidade 1.000 e o código 10, então essa informação deverá ser levada para a tabela OPC para um registro de mesmo VER com o campo MAP das duas tabelas sendo preenchido com "R"

    Na tabela FUN tenho um VER com quantidade 5.000, mas na tabela OPC eu só tenho 3 itens de mesmo ver que ainda não tem o campo código preenchido, então na tabela OPC esse VER deverá ser prenchido no campo MAP com R5R3 e ser levado junto com o código para a tabela OPC, aos três registros disponíveis

    O VER que tiver em seu campo a quantidade 0.000 deverá ser assumida como 1.000 ( Hum )

    O exemplo em anexo irá esclarece-los bastante

    Desde já agradeço a atenção e a costumeira ajuda dos senhores
    Anexos
    TESTE_PRO.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (23 Kb) Baixado 12 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: Contagem e preenchimento

    Mensagem  Alexandre Neves em 18/7/2018, 17:29

    Boa tarde,
    Ainda não resolveu? Dê exemplo significativo para os dados apresentados


    .................................................................................
    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: Contagem e preenchimento

    Mensagem  Carlao2 em 18/7/2018, 21:08

    Boa tarde Alexandre.

    Primeiramente, muito obrigado pelo contato.

    Ainda não consegui resolver e confesso, está muito complicado para encontrar a solução para esse problema

    Vou tentar elucidar ao máximo o que pretendo

    Na Tabela fun tenho um registo com o "código" 22, "ver" per, "quant" 3.000(Tres), "planta" pj

    Na tabela opc eu tenho 4 registros com o campo "ver" per, "planta" pj

    Pois bem

    Preciso um código que leia esse campo quantidade, no exemplo 3.000 e fazendo a amarração pela "planta", veja que na tabela opc tem 4 registros preenchidos com o campo "ver"= per.

    Nesse caso ele deve preencher o campo codigo da tabela opc com o código do registro da tabela fun, ou seja 22 e o campo "map" da tabela opc com R3 para os tres registros e o 4 registro deverá ficar em branco.

    Seguindo esse raciocínio, imagine que na tabela fun esse registro tivesse a quantidade 5.000(cinco) e na tabela opc tivesse somente 3 registro na mesma "planta", nesse caso o campo registro da da tabela opc seria preenchido com 22 nos tres registros existentes e o campo "map" da tabela opc para os tres registros seria preenchido com R5R3, ou seja uma quantidade de 5 para 3 registros encontrados.

    Para os registros da tabela fun com o campo quant preenchidos com 0.000 ou em branco deve-se entender que a quantidade seja 1.000(hum).

    Não sei se fui claro o suficiente.

    Qualquer dúvida estou à disposição.

    Desde já agradeço
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Contagem e preenchimento

    Mensagem  Alexandre Neves em 19/7/2018, 17:42

    Boa tarde
    Não entendi que campo registro se refere: "nesse caso o campo registro da da tabela opc seria preenchido com 22"


    .................................................................................
    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: Contagem e preenchimento

    Mensagem  Carlao2 em 19/7/2018, 19:44

    Olá Alexandre. Boa tarde

    Quando eu disse registro me referi ao registro da tabela, o campo a ser preenchido com o 22 é o "Código"


    Qualquer dúvida estou à disposição

    Obrigado
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Contagem e preenchimento

    Mensagem  Alexandre Neves em 19/7/2018, 22:32

    Execute este código

    Código:
    Sub PreencheTabela()
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim RstFUN As dao.Recordset, RstOPC As dao.Recordset, RstLigados As dao.Recordset, intLigados As Integer, i As Integer
       
        Set RstFUN = CurrentDb.OpenRecordset("SELECT * FROM [Tabela FUN]")
        Set RstOPC = CurrentDb.OpenRecordset("SELECT * FROM [Tabela OPC]")
        Do While Not RstFUN.EOF
            intLigados = 0
            RstOPC.MoveFirst
            Do While Not RstOPC.EOF
                If RstOPC("ver") = RstFUN("ver") And RstOPC("map") = RstFUN("map") Then intLigados = intLigados + 1
                RstOPC.MoveNext
            Loop
       
            If intLigados > 0 Then
                RstOPC.Filter = "ver='" & RstFUN("ver") & "' and map='" & RstFUN("map") & "'"
                Set RstLigados = RstOPC.OpenRecordset
                For i = 1 To intLigados - 1
                    RstLigados.Edit
                    RstLigados("Codigo") = RstFUN("Codigo")
                    If Val(RstFUN("Quant")) = 0 Then
                        RstLigados("map") = "R1R" & intLigados
                    Else
                        RstLigados("map") = "R" & Val(RstFUN("Quant")) & "R" & intLigados
                    End If
                    RstLigados.Update
                    RstLigados.MoveNext
                Next
                RstLigados.Edit
                RstLigados("Codigo") = Null
                RstLigados("map") = Null
                RstLigados.Update
            End If
            RstFUN.MoveNext
        Loop
        Set RstFUN = Nothing: Set RstOPC = Nothing
    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: Contagem e preenchimento

    Mensagem  Carlao2 em 19/7/2018, 23:09

    Boa noite Alexandre.

    Executei o módulo e nada aconteceu.

    Só para lembrar, as duas tabelas deverão estar cruzadas pelo campo "Planta"


    Desde já agradeço o seu interesse em ajudar
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Contagem e preenchimento

    Mensagem  Alexandre Neves Ontem à(s) 09:00

    Bom dia,
    Veja agora
    Código:
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim RstFUN As dao.Recordset, RstOPC As dao.Recordset, RstLigados As dao.Recordset, intLigados As Integer, i As Integer
       
        Set RstFUN = CurrentDb.OpenRecordset("SELECT * FROM [Tabela FUN]")
        Set RstOPC = CurrentDb.OpenRecordset("SELECT * FROM [Tabela OPC]")
        Do While Not RstFUN.EOF
            intLigados = 0
            RstOPC.MoveFirst
            Do While Not RstOPC.EOF
                If RstOPC("ver") = RstFUN("ver") And RstOPC("Planta") = RstFUN("Planta") Then intLigados = intLigados + 1
                RstOPC.MoveNext
            Loop
       
            If intLigados > 0 Then
                RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                Set RstLigados = RstOPC.OpenRecordset
                For i = 1 To intLigados - 1
                    RstLigados.Edit
                    RstLigados("Codigo") = RstFUN("Codigo")
                    If Val(RstFUN("Quant")) = 0 Then
                        RstLigados("map") = "R1R" & intLigados
                    Else
                        RstLigados("map") = "R" & Val(RstFUN("Quant")) & "R" & intLigados
                    End If
                    RstLigados.Update
                    RstLigados.MoveNext
                Next
                RstLigados.Edit
                RstLigados("Codigo") = Null
                RstLigados("map") = Null
                RstLigados.Update
            End If
            RstFUN.MoveNext
        Loop
        Set RstFUN = Nothing: Set RstOPC = Nothing


    .................................................................................
    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: Contagem e preenchimento

    Mensagem  Carlao2 Ontem à(s) 12:43

    Bom dia Alexandre.

    Está quase chegando lá, exceto por uns poucos detalhes, que vou tentar elucidar melhor para você

    Ao rodar o módulo ele não está preenchendo o MAP da tabela Fun
    E está fazendo os lancamentos na tabela Opc com quantidades diferentes.
    Vou tentar colocar abaixo um exemplo de como o módulo deverá proceder

    Tabela Fun

    Codigo Map Ver Quantidade Planta
    10 Pedro 3.000 Lm


    Tabela Opc

    Codigo Map Ver Planta

    10 R3 Pedro Lm
    10 R3 Pedro Lm
    10 R3 Pedro Lm
    Pedro Lm

    Note que na tabela Opc, na planta Lm tenho 4 registros com o ver Pedro, nesse caso, como a quantidade desse registro na tabela Fun é 3.000,
    na tabela Opc, 1 registro deverá ficar em branco


    Tabela Fun

    Codigo Map Ver Quantidade Planta
    15 R5R4 Antonio 5.000 Jk


    Tabela Opc

    Codigo Map Ver Planta

    15 R5R4 Antonio Jk
    15 R5R4 Antonio Jk
    15 R5R4 Antonio Jk
    15 R5R4 Antonio Jk

    Nesse outro exemplo, na tabela Fun, planta Jk, tenho um registro com o codigo 15 Ver Antonio e Quantidade 5.000, porém na tabela Opc, para essa planta eu só tenho 4 itens com o Ver Antonio, então na tabela Fun campo Map deverá ser preenchido R5R4 ("R5" porque a quantidade é 5 e R4 porque esse registro será levado para 4 itens somente da tabela Opc)

    No caso de na tabela Fun a quantidade for 0.000 ou 1.000, ambas serão considerados como 1 e o campo Map será preenchido com R, e deverá ser levado para apenas 1 registro da tabela Opc, "se houver"
    Caso eu tenha um registro na tabela Fun e não tenha um correspondente na tabela Opc, esse registro deverá ficar com o Map em branco na tabela Fun

    Qualquer dúvida é só falar

    Mais uma vez muito obrigado

    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Contagem e preenchimento

    Mensagem  Alexandre Neves Ontem à(s) 13:22

    Boa tarde,
    Código:
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim RstFUN As dao.Recordset, RstOPC As dao.Recordset, RstLigados As dao.Recordset, intLigados As Integer, i As Integer
       
        Set RstFUN = CurrentDb.OpenRecordset("SELECT * FROM [Tabela FUN]")
        Set RstOPC = CurrentDb.OpenRecordset("SELECT * FROM [Tabela OPC]")
        Do While Not RstFUN.EOF
            If Val(RstFUN("Quant")) = 0 Or Val(RstFUN("Quant")) = 1 Then
                RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                Set RstLigados = RstOPC.OpenRecordset
                RstFUN.Edit
                If RstLigados.EOF Then
                    RstFUN("map") = Null
                Else
                    RstFUN("map") = "R"
                    RstLigados.Edit
                    RstLigados("map") = "R"
                    RstLigados.Update
                End If
                RstFUN.Update
            Else
                intLigados = 0
                RstOPC.MoveFirst
                Do While Not RstOPC.EOF
                    If RstOPC("ver") = RstFUN("ver") And RstOPC("Planta") = RstFUN("Planta") Then intLigados = intLigados + 1
                    RstOPC.MoveNext
                Loop
           
                If intLigados > 0 Then
                    RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                    Set RstLigados = RstOPC.OpenRecordset
                    For i = 1 To intLigados - 1
                        RstLigados.Edit
                        RstLigados("Codigo") = RstFUN("Codigo")
                        If Val(RstFUN("Quant")) = 0 Then
                            RstLigados("map") = "R1R" & intLigados
                        Else
                            If Val(RstFUN("Quant")) = intLigados Then
                                RstLigados("map") = "R" & intLigados
                            Else
                                RstLigados("map") = "R" & Val(RstFUN("Quant")) & "R" & intLigados
                            End If
                        End If
                        RstLigados.Update
                        RstLigados.MoveNext
                    Next
                    RstLigados.Edit
                    RstLigados("Codigo") = Null
                    RstLigados("map") = Null
                    RstLigados.Update
                End If
            End If
            RstFUN.MoveNext
        Loop
        MsgBox Date
        Set RstFUN = Nothing: Set RstOPC = Nothing:: Set RstLigados = Nothing


    .................................................................................
    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: Contagem e preenchimento

    Mensagem  Carlao2 Ontem à(s) 13:58

    Alexandre. Falta pouco

    No caso do registro China da tabela Fun ele fez correto, porém não levou o código para a tabela Opc

    Já no caso do Pedro onde a quantidade é 3.000 ele não preencheu o map da tabela Fun e levou os dados para 5 registros da tabela Opc com o Map R3R6, quando o correto seria somente R3 e para somente 3 registros da tabela Opc, pois a quantidade da tabela Fun é 3.000 e eu tenho 3 ou mais registros na tabela Opc

    Ele só deve mostrar a discrepância quando houver, exemplo:
    Na tabela Fun o registro tem a quantidade 6.000 e na tabela Opc existem somente 4 registros equivalentes, nesse caso o Map seria R6R4 e essa informação seria levada para os 4 registros da tabela Opc

    No caso de ser ao contrario, ou seja na tabela Fun ter um registro com quantidade 7.000 e na tabela Opc eu tiver 10 registros equivalentes o Map da tabela Fun seria R7 e a informação levada para a tabela Opc para os sete registros e os outros 3 ficariam em branco, lembrando que o Código da tabela Fun deverá ser levado para a tabela Opc também.

    Grato
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Re: Contagem e preenchimento

    Mensagem  Alexandre Neves Ontem à(s) 16:05

    Veja agora
    Se não estiver certo crie dados significativos (que cubram todas as situações) e descreva-as
    Código:
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Dim RstFUN As dao.Recordset, RstOPC As dao.Recordset, RstLigados As dao.Recordset, intLigados As Integer, i As Integer
       
        Set RstFUN = CurrentDb.OpenRecordset("SELECT * FROM [Tabela FUN]")
        Set RstOPC = CurrentDb.OpenRecordset("SELECT * FROM [Tabela OPC]")
        Do While Not RstFUN.EOF
            If Val(RstFUN("Quant")) = 0 Or Val(RstFUN("Quant")) = 1 Then
                RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                Set RstLigados = RstOPC.OpenRecordset
                RstFUN.Edit
                If RstLigados.EOF Then
                    RstFUN("map") = Null
                Else
                    RstFUN("map") = "R"
                    RstLigados.Edit
                    RstLigados("map") = "R"
                    RstLigados("Codigo") = RstFUN("Codigo")
                    RstLigados.Update
                End If
                RstFUN.Update
            Else
                intLigados = 0
                RstOPC.MoveFirst
                Do While Not RstOPC.EOF
                    If RstOPC("ver") = RstFUN("ver") And RstOPC("Planta") = RstFUN("Planta") Then intLigados = intLigados + 1
                    RstOPC.MoveNext
                Loop
           
                Select Case intLigados
                Case 0
                Case Is > Val(RstFUN("Quant"))
                    RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                    Set RstLigados = RstOPC.OpenRecordset
                    RstFUN.Edit
                    RstFUN("map") = "R" & intLigados
                    RstFUN.Update
                    For i = 1 To Val(RstFUN("Quant"))
                        RstLigados.Edit
                        RstLigados("Codigo") = RstFUN("Codigo")
                        RstLigados("map") = "R" & intLigados
                        RstLigados.Update
                        RstLigados.MoveNext
                    Next
                Case Else
                    RstOPC.Filter = "ver='" & RstFUN("ver") & "' and Planta='" & RstFUN("Planta") & "'"
                    Set RstLigados = RstOPC.OpenRecordset
                    For i = 1 To intLigados - 1
                        RstLigados.Edit
                        RstLigados("Codigo") = RstFUN("Codigo")
                        RstFUN.Edit
                        If Val(RstFUN("Quant")) = 0 Then
                            RstLigados("map") = "R1R" & intLigados
                        Else
                            If Val(RstFUN("Quant")) = intLigados Then
                                RstLigados("map") = "R" & intLigados
                                RstFUN("map") = "R" & intLigados
                            Else
                                RstLigados("map") = "R" & Val(RstFUN("Quant")) & "R" & intLigados
                                RstFUN("map") = "R" & Val(RstFUN("Quant")) & "R" & intLigados
                            End If
                        End If
                        RstFUN.Update
                        RstLigados.Update
                        RstLigados.MoveNext
                    Next
                End Select
               
                Do While Not RstLigados.EOF
                    RstLigados.Edit
                    RstLigados("Codigo") = Null
                    RstLigados("map") = Null
                    RstLigados.Update
                    RstLigados.MoveNext
                Loop
            End If
            RstFUN.MoveNext
        Loop
        MsgBox Date
        Set RstFUN = Nothing: Set RstOPC = Nothing:: Set RstLigados = Nothing


    .................................................................................
    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

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