Página 1 de 1

Valores duplicados

Enviado: 27 Abr 2015 às 17:00
por duds
Boa tarde

Eu possuo uma pasta de trabalho que estou utilizando para um certo estudo que possui uma macro que cadastra os dados que coloco ali, são apenas alguns dados específicos que puxo de um arquivo txt que coloco em uma das planilhas, porém são tantos que as vezes me perco e cadastro alguns repetidos. Como eu gosto de automatizar ao máximo meus processos, gostaria de saber se alguém sabe como já na hora do cadastro verificar se aquele cadastro já foi previamente feito usando de base o número do teste (que é sempre classificado ao fim da macro em ordem decrescente), logo em seguida avisar que era repetido e excluir o a linha.
Segue o código simplificado que uso por enquanto:


Sub Cadastro()

Worksheets("Resumo").Select
Range("A3").Select '….Seleciona primeira linha preenchida
Selection.End(xlDown).Select '….vai até última linha preenchida

Selection.Offset(1, 0).Select
Selection.ListObject.ListRows.Add
Selection = Worksheets("Captação de dados").Range("A6")
Selection.Offset(0, 1).Select
Selection = Worksheets("Captação de dados").Range("B6")
Selection.Offset(0, 1).Select
Selection = Worksheets("Captação de dados").Range("C6")
Selection.Offset(0, 1).Select
Selection = Worksheets("Captação de dados").Range("D6")
Selection.Offset(0, 2).Select
Selection = Worksheets("Captação de dados").Range("E6")
Selection.Offset(0, 1).Select
Selection = Worksheets("Captação de dados").Range("F6")

ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
SortFields.Add Key:=Range("B4"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("A3").Activate

Worksheets("Seg Seg").Select
Range("A1").Select

End Sub



Cross posts:
http://forum.clubedohardware.com.br/top ... uplicados/

Re: Valores duplicados

Enviado: 27 Abr 2015 às 17:13
por alexandrevba
Boa tarde!!

Tem como postar seu arquivo modelo compactado?
Você consegue adaptar algo assim...
Código: Selecionar todos
 If WorksheetFunction.CountIf(SuaGuia.Range("A2", SuaGuia.Cells(iRow, 1)), SeuCampoAqui.Value) > 0 Then
        MsgBox "Dados duplicados", vbCritical
        Exit Sub
    End If
Att

Valores duplicados

Enviado: 27 Abr 2015 às 17:31
por duds
Primeiramente obrigado pela atenção Alexandre,

Então, duas perguntas:
1ª - o que eu deveria colocar em SeuCampoAqui?
2ª - não entendi como funciona esse código, seria muito complicado me explicar? se sim tudo bem, mas se não agradeceria muito para aprender :D

Re: Valores duplicados

Enviado: 27 Abr 2015 às 17:35
por alexandrevba
Boa tarde!

Perdão pela confusão...
1ª - o que eu deveria colocar em SeuCampoAqui?
Seu intervalo A1:A50
2ª - não entendi como funciona esse código, seria muito complicado me explicar? se sim tudo bem, mas se não agradeceria muito para aprender
Conta os valores repetidos em um intervalo A1:A50

Para ficar melhor seria bom que postasse seu arquivo modelo e compactado!

Att

Valores duplicados

Enviado: 27 Abr 2015 às 17:59
por duds
Hmmmm, muito obrigado Alexandre, porém não consegui adaptar o código, segue a planilha resumida

Re: Valores duplicados

Enviado: 29 Abr 2015 às 13:17
por alexandrevba
Boa tarde!

Qual é a coluna que não pode repetir?

Enquanto isso eu reduzir um pouco seu código.
Código: Selecionar todos
Sub AleVBA_88()

    Worksheets("Resumo").Select
    Dim tblLastRow As Object
    Set tblLastRow = Worksheets("Resumo").ListObjects("Resumo").ListRows.Add
    Worksheets("Captação de dados").Range("A6:C6, E6, H6:O6").Copy
    tblLastRow.Range.PasteSpecial xlPasteValues
    Application.CutCopyMode = False

ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
        SortFields.Add Key:=Range("B4"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A3").Activate

Worksheets("Seg Seg").Select
Range("A1").Select

End Sub
Att

Valores duplicados

Enviado: 29 Abr 2015 às 13:27
por duds
Hmmm muito obrigado xD
A coluna de que será a base de comparação será a coluna em vermelho: TESTE

Re: Valores duplicados

Enviado: 29 Abr 2015 às 13:47
por alexandrevba
Boa tarde!!

Eu estou imaginando (se é que eu entendi sua dúvida), que o dado da célula B6 da guia Captação é fixo...
Código: Selecionar todos
Sub AleVBA_88V2)
    Dim tblLastRow As Object

    If WorksheetFunction.CountIf(Worksheets("Resumo").ListObjects("Resumo").ListColumns(2).Range, Worksheets("Resumo").Range("B6").Value) > 0 Then
        MsgBox "Dados duplicados", vbCritical
        Exit Sub
    Else
        Worksheets("Resumo").Select
        Set tblLastRow = Worksheets("Resumo").ListObjects("Resumo").ListRows.Add
        Worksheets("Captação de dados").Range("A6:C6, E6, H6:O6").Copy
        tblLastRow.Range.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If

ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort. _
        SortFields.Add Key:=Range("B4"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Resumo").ListObjects("Resumo").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A3").Activate

Worksheets("Seg Seg").Select
Range("A1").Select

End Sub
Att

Valores duplicados

Enviado: 29 Abr 2015 às 15:48
por duds
Alexandre, sensacional!
Não funcionou exatamente como eu imaginei, porém me deu uma luz, adaptei seu código e funcionou perfeitamente!
Muito Obrigado