Este fórum está sendo desativado

[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/

[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

[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

[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

[duds]

Hmmmm, muito obrigado Alexandre, porém não consegui adaptar o código, segue a planilha resumida

[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

[duds]

Hmmm muito obrigado xD
A coluna de que será a base de comparação será a coluna em vermelho: TESTE

[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

[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