Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Excluir Matriculas ...
 
Notifications
Clear all

Excluir Matriculas Antigas

 
2024 - VBA & Macros
Post Recente por romanholi 7 anos atrás
4 Posts
3 Usuários
0 Reactions
1,132 Visualizações
RSS
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Bom Dia!

Preciso de uma macro que exclua as linhas no meu Banco de Dados dos funcionários que foram recontratados, ou seja, quando o funcionário tem mais de uma matricula, excluir as linhas da matricula anterior, que a matricula sempre será um numero menor!

Deixei uma parte da base de dados para ajuda dos amigos! Essa base é é bem grande... preciso fazer essa macro, vai me ajudar muito!

Em vermelho, nesse exemplo, o que deverá ser excluído excluir!

Obrigado Pessoal

 
Postado : 03/08/2017 7:03 am
 gfranco
(@wzxnet7)
Posts: 0
New Member
 

Bom dia.
Veja se atende

 
Postado : 03/08/2017 7:26 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Segue

Sub AleVBA_25569()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row

With Columns("A:D")
    ActiveWorkbook.Worksheets("Plan2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Plan2").Sort.SortFields.Add Key:=Range("A2:A22"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Plan2").Sort.SortFields.Add Key:=Range("B2:B22"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Plan2").Sort
        .SetRange Range("A1:D" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
    ActiveSheet.Range("A1:D" & lr).RemoveDuplicates Columns:=1, Header:=xlYes
End Sub

Obs: Recorte a coluna C e cole no lugar da coluna B

Att

 
Postado : 03/08/2017 8:17 am
 romanholi
(@romanholi)
Posts: 0
New Member
Topic starter
 

Perfeito! Ambos resolvem!

Muitíssimo Obrigado!

 
Postado : 03/08/2017 1:26 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico