MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Função para não copiar dados duplicados

    avatar
    Chamon Consultoria
    Avançado
    Avançado

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 246
    Registrado : 31/08/2012

    Função para não copiar dados duplicados Empty Função para não copiar dados duplicados

    Mensagem  Chamon Consultoria em 15/11/2020, 16:49

    Boa tarde!

    Bd em Access 2010.


    O objetivo é copiar os registros da tabela "xmlProdutos" para a tabela "tbl_Produtos".

    Obs: na tabela xmlProdutos existem registros iguais. Porém no momento de copiá-los para a tabela "tbl_Produtos" (usando como comparação o conteúdo do campo "XMLDESC" da tabela "xmlProdutos"), gostaria que apenas um desses registros (repetidos) fosse salvo na "tbl_Produtos".

    Da maneira que está a função, todos os registros estão sendo copiados.

    Segue exemplo em anexo.

    Desde já agradeço pela ajuda.
    Anexos
    Função para não copiar dados duplicados AttachmentCopiar Dados Duplicados.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (52 Kb) Baixado 2 vez(es)
    Alexandre Neves
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

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

    Função para não copiar dados duplicados Empty Re: Função para não copiar dados duplicados

    Mensagem  Alexandre Neves em 16/11/2020, 10:02

    Bom dia
    Nomeie de forma normalizada. Declare as variáveis explicitamente. Ajuda muito na hora de ler/interpretar o código
    Veja se o código funciona como pretende (adapte para o tipo de dados nos campos texto)
    Código:
    Private Sub Comando1_Click()
        Dim rDup As DAO.Recordset
        Dim txtNomPro
       
        Set db = CurrentDb()
        Set rs = db.OpenRecordset("tbl_Produtos")
           
        strSQL = "SELECT * FROM xmlProdutos WHERE SELECIONAR = -1"
        Set Rst = db.OpenRecordset(strSQL)

        txtCodPro = Nz(DMax("CODPRO", "tbl_Produtos"), 0) + 1

        Do While Not Rst.EOF
            Set rDup = CurrentDb.OpenRecordset("SELECT * FROM tbl_Produtos WHERE CODPROFOR=" & Rst("ccVarPro") & " AND ccNomPro =" & Rst("ccNomPro") & " and ccMEDIDA =" & Rst("ccMedida") & " and ccNCM=" & Rst("ccNCM") & " and ccPreçoCusto =" & Rst("CUSTO") & " and ccnFCI =" & Rst("ccnFCI") & " and ccinfAdProd=" & Rst("ccinfAdProd") & " and ccOrigem=" & Rst("ccorig") & " and ccPreçoCustoFinal=" & Rst("CUSTO") & " and ccPreçoVenda=" & Rst("CUSTO") & " and XMLDESC=" & Rst("ccVarPro") & Rst("ccNomPro") & Rst("ccinfAdProd"))
            If rDup.EOF = False Then GoTo NaoRegista
            rs.AddNew

            rs("CODPRO") = txtCodPro
            rs("ccVarPro") = Format(txtCodPro, "00000")

            rs("CODPROFOR") = Rst("ccVarPro")
            rs("ccNomPro") = Rst("ccNomPro")

            txtNomPro = Rst("ccNomPro")

            rs("ccMEDIDA") = Rst("ccMedida")

            rs("ccNCM") = Rst("ccNCM")

            Dim txtNCM
            txtNCM = Rst("ccNCM")

            rs("ccPreçoCusto") = Rst("CUSTO")
            rs("ccnFCI") = Rst("ccnFCI")

            Dim txtnFCI
            txtnFCI = Rst("ccnFCI")

            rs("ccinfAdProd") = Rst("ccinfAdProd")

            rs("ccOrigem") = Rst("ccorig")


            rs("ccTipo") = 2
            rs("CODGRUPO") = 1
            rs("ccCFOP") = 5102
            rs("ccCST") = "000"
            rs("ccCSOSN") = 101
            rs("ccCOFINS") = 0
            rs("ccCOFINSCST") = "49"
            rs("ccPIS") = 0
            rs("ccPISCST") = "49"
            rs("ccIPI") = 0
            rs("ccIPICST") = 99
            rs("ccPreçoCustoFinal") = Rst("CUSTO")
            rs("ccPreçoVenda") = Rst("CUSTO")
            rs("cccEnq") = 999
            rs("cdDatCad") = Format(Now(), "dd/mm/yyyy")
            rs("ccPrecoPauta") = "0,00"
            '----------------------------------------------------------
            rs("ccICMSENTRADA") = 0
            rs("ccICMSSAIDA") = 0
            rs("ccCUSTOOPERACIONAL") = 0
            rs("ccOUTROSIMPOSTOS") = 0
            rs("ccCOMISSAO") = 0
            rs("ccPrecoPauta") = 0
            rs("ccMVA") = 0
            rs("ccMargemLucro") = 0
            rs("ccNívelEstoque") = 0
            '-------------------------------------------
            rs("ccTipoFator") = 0
            rs("xTipoFator") = "Dividir por"
            rs("CODFORN") = txtCGC
            rs("ccFatorConversao") = 1
            rs("ccEstoque") = 0
            rs("ccMargemDesconto") = 0
            rs("ccTipoGrade") = 1
            rs("XMLDESC") = Rst("ccVarPro") & Rst("ccNomPro") & Rst("ccinfAdProd")

            rs("ccAtivo") = True

            rs.Update

            Rst.MoveNext

            '        Me.CODIGO = txtCodPro
            '        Me.Nome = txtNomPro

            Me.Requery
            Me.Repaint
            Me.Refresh

            txtCodPro = txtCodPro + 1
    NaoRegista:
        Loop

        rs.Close
       
        MsgBox "Dados Copiados com Sucesso!"

        Me.Requery    'Chamon 28-10-2020

    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

      Data/hora atual: 3/12/2020, 20:07