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]Localizar duplicidade e deletar a data menor da tabela

    Compartilhe
    avatar
    Fabrícia Lima
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 58
    Registrado : 17/06/2013

    [Resolvido]Localizar duplicidade e deletar a data menor da tabela

    Mensagem  Fabrícia Lima em Seg 10 Jul 2017, 09:33

    Bom dia!

    Eu estou precisando muito de ajuda com a seguinte questão:

    No meu formulário de cadastro de treinamentos eu registro via VBA para tabela, após registro localizo a duplicidade de e deleto informação.

    O único problema é que ele deleta exatamente o que eu lancei, eu quero que ele delete por critério de data, mantendo a data mais recente.

    segue código para possível adaptação!

    Código:
    Public Sub Duplicidade()
    On Error Resume Next
    Dim db As DAO.Database, rst As DAO.Recordset
    Dim strNome As String, strSaveName As String


    'MsgBox "Analisar Dados..."

    Set db = CurrentDb()
    Set rst = db.OpenRecordset("select * from Treinamentos_EHS order by  Treinamento, Nome ASC;")
    If rst.BOF And rst.EOF Then


    Else
    rst.MoveFirst
    Do Until rst.EOF
    strDupName = rst.Fields("Treinamento") & rst.Fields("Nome")

    If strDupName = strSaveName Then
    rst.Delete



    Else
    strSaveName = rst.Fields("Treinamento") & rst.Fields("Nome")

    End If
    rst.MoveNext

    Loop
    Set rst = Nothing

    Set db = Nothing



    End If


    End Sub
    avatar
    JPaulo
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 9703
    Registrado : 04/11/2009

    Re: [Resolvido]Localizar duplicidade e deletar a data menor da tabela

    Mensagem  JPaulo em Seg 10 Jul 2017, 17:42

    Ola;

    Onde diz SeuCampoData, altere para o nome correto;

    Código:
    Public Sub Duplicidade()
    On Error Resume Next
    Dim db As DAO.Database, rst As DAO.Recordset
    Dim strNome As String, strSaveName As String

    'MsgBox "Analisar Dados..."

    Set db = CurrentDb()
    Set rst = db.OpenRecordset("select * from Treinamentos_EHS order by  Treinamento ASC, Nome ASC, SeuCampoData DESC;")
    'se não encontrar registros, saí do codigo
    If rst.RecordCount = 0 Then Exit Sub
    'se encontrar move para o 1º registro
    rst.MoveFirst

    Do Until rst.EOF
    strDupName = rst.Fields("Treinamento") & rst.Fields("Nome")
    If strDupName = strSaveName Then
    rst.Delete
    Else
    strSaveName = rst.Fields("Treinamento") & rst.Fields("Nome")
    End If
    rst.MoveNext

    Loop
    rst.Close: Set rst = Nothing
    db.Close: Set db = Nothing
    End Sub


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver este link.]

    Sucesso e Bons Estudos
    Success and Good Studies

    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    [Você precisa estar registrado e conectado para ver esta imagem.] [Você precisa estar registrado e conectado para ver este link.]
    avatar
    Fabrícia Lima
    Intermediário
    Intermediário

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 58
    Registrado : 17/06/2013

    Re: [Resolvido]Localizar duplicidade e deletar a data menor da tabela

    Mensagem  Fabrícia Lima em Sex 14 Jul 2017, 21:05

    Muito Obrigado funcionou perfeitamente cheers

      Data/hora atual: Qua 22 Nov 2017, 20:07