Contagem e preenchimento

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

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

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

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

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

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


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

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


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

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


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

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

Alexandre. Bom dia.

Você está quase lá, se não fosse uns detalhes apenas.
Não achei outra maneira de exemplificar e explicar melhor para que você entenda como funciona o processo.
Então montei esse arquivo em anexo com exemplos, comentários e observações, que acredito, serão suficientes para que você compreenda a logística da coisa.
Nesse exemplo temos as duas tabelas no "Antes" e elas no "depois" de rodado o módulo.
Muito obrigado pela força

No aguardo

Boa tarde

Estou a tentar perceber a lógica e não entendo a lógica dos registos com ver='per' e planta='pj'

Boa tarde Alexandre.

Vamos lá vou tentar esclarecer

A planta é somente um campo de amarração, pois posso ter um registro de mesmo VER em plantas diferentes e os lançamentos terão de ser feitos dentro da mesma planta.

Agora com relação do Ver=Per, eu tenho na tabela Fun na planta pj, 3 registros com quantidades de 4, 1, 1, ou seja como se eu tivesse 6 registros com quantidade 1.
Porém na tabela Opc, planta pj eu tenho somente 4 registros com o ver=Per.
Imagine que eu teria que amarrar 1 da tabela Fun com 1 da tabela Opc.
Então começo com os de quantidade 1 que são dos de código 13 e 22 da tabela Fun, amarrei cada um deles com um registro da tabela Opc.
Agora pego o registro 17 da Tabela Fun que tem a quantidade 4 e vou amarrar com 4 registros da tabela Opc, mas quando vou fazer isso vejo que só tenho 2 registros faltando amarração na tabela Opc na mesma planta, dai o Map R4R2, ou seja amarração de um registro com quantidade 4 à somente 2 registros da tabela OPC.


Só elucidando um pouco mais.

Feito isso, imagine que futuramente entre na tabela Opc na planta pj, mais dois registros com o ver=per.
Só olhando o Map da Tabela Opc, R4R2 eu sei que vou ter que refazer a amarração do ver=per, para zerar o item com quantidade 4 da tabela Fun,
pois os dois registros faltantes acabara de entrar na tabela Opc

Grato

Boa noite,
Veja agora

Código:

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '  código criado por Alexandre Neves, do Fórum MaximoAccess                                                '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim RstGrFUN As dao.Recordset, RstFUN As dao.Recordset, RstOPC As dao.Recordset, RstLigados As dao.Recordset, intLigados As Integer, intPorLigar As Integer
   
    Set RstGrFUN = CurrentDb.OpenRecordset("SELECT Sum(Val(Quant)) as S, ver, planta FROM [Tabela FUN] GROUP BY ver,planta")
    Set RstOPC = CurrentDb.OpenRecordset("SELECT * FROM [Tabela OPC]")
    Do While Not RstGrFUN.EOF
        Set RstFUN = CurrentDb.OpenRecordset("SELECT * FROM [Tabela FUN] WHERE ver='" & RstGrFUN("ver") & "' and planta='" & RstGrFUN("planta") & "' ORDER BY Val(Quant),Codigo")
        RstOPC.Filter = "ver='" & RstGrFUN("ver") & "' and Planta='" & RstGrFUN("Planta") & "'"
        Set RstLigados = RstOPC.OpenRecordset
        If RstGrFUN("S") = 0 Or RstGrFUN("S") = 1 Then
            Do While Not RstFUN.EOF
                RstFUN.Edit
                RstFUN("map") = "R"
                Do While Not RstLigados.EOF
                    RstLigados.Edit
                    RstLigados("map") = "R"
                    RstLigados("Codigo") = RstFUN("Codigo")
                    RstLigados.Update
                    RstLigados.MoveNext
                Loop
                RstFUN.Update
                RstFUN.MoveNext
            Loop
        Else
            If Not RstLigados.EOF Then RstLigados.MoveLast: RstLigados.MoveFirst
            If RstLigados.RecordCount = 0 Then
            ElseIf RstGrFUN("S") = RstLigados.RecordCount Then
                Do While Not RstFUN.EOF
                    RstFUN.Edit
                    RstFUN("map") = "R" & RstGrFUN("S")
                    Do While Not RstLigados.EOF
                        RstLigados.Edit
                        RstLigados("map") = "R" & RstGrFUN("S")
                        RstLigados("Codigo") = RstFUN("Codigo")
                        RstLigados.Update
                        RstLigados.MoveNext
                    Loop
                    RstFUN.Update
                    RstFUN.MoveNext
                Loop
            Else
                intPorLigar = RstGrFUN("S")
                Do While Not RstFUN.EOF
                    RstFUN.Edit
                    If Val(RstFUN("Quant")) < intPorLigar Then
                        RstFUN("map") = "R"
                        If Not RstLigados.EOF Then
                            RstLigados.Edit
                            RstLigados("map") = "R"
                            RstLigados("Codigo") = RstFUN("Codigo")
                            RstLigados.Update
                            RstLigados.MoveNext
                        End If
                    Else
                        RstFUN("map") = "R" & Val(RstFUN("Quant")) & "R" & intPorLigar
                        RstLigados.Edit
                        RstLigados("map") = "R" & Val(RstFUN("Quant")) & "R" & intPorLigar
                        RstLigados("Codigo") = RstFUN("Codigo")
                        RstLigados.Update
                    End If
                    RstFUN.Update
                    intPorLigar = intPorLigar - 1
                    RstFUN.MoveNext
                Loop
            End If
        End If
        RstGrFUN.MoveNext
    Loop
    Set RstGrFUN = Nothing: Set RstFUN = Nothing: Set RstOPC = Nothing:: Set RstLigados = Nothing

Boa Noite Alexandre.

Agora parece estar funcionando, só tem um problema

No caso do ver=Mar onde a quantidade é 5 ele colocou o Map R5 e lançou nos 5 registros de mesma planta disponíveis na tabela opc (correto)
Já com o ver=pedro onde a quantidade é 3 ele colocou o Map=R3R3 e lançou somente em 1 registro da tabela opc e lá na mesma planta tem outros dois registros que ficaram em branco.

O que poderia ser isso

Boa noite,

Diz o que está errado. E como devia estar certo?

Ola Alexandre.

Então, no caso do ver=pedro, como na tabela fun a quantidade é 3 e na tabela opc, na mesma planta eu tenho os três registros deveria funcionar tal qual ele fez com o ver=mar, ou seja na tabela fun colocar o map R3 e preencher os três registros da tabela Opc, e ele fez de maneira errada colocando no map da tabela fun,  R3R3 e levando para 1 registro da tabela opc
O que notei foi que ele faz somente se a quantidade for igual ou seja se o ver da tabela Fun tiver a quantidade 5.000 e na tabela Opc eu tiver exatamente 5 registro de mesmo ver na mesma planta ele faz, colocando na tabela Fun Map=R5 e levando para os 5 registros da tabela Opc, caso na tabela Opc eu tenha 6 registros ele coloca MAP = R5R6 e leva para somente 1 registro da tabela OPC, quando o correto seria R5, levando os dados para 5 registros da tabela OPC e deixando 1 registro em branco.
E no caso de eu ter na tabela OPC apenas 4 registros, ai sim ele colocaria no Map da tabela Fun R5R4 e levaria para os 4 registros da tabela OPC