Excluir linha com criterio em celulas variáveis

VBA & Macros

Post Recente por TutoElizeu 6 anos atrás

4 Posts

3 Usuários

0 Likes

939 Visualizações

RSS

TutoElizeu

(@tutoelizeu)

Posts: 160

Estimable Member

Topic starter

Boa noite,

Preciso de uma grande ajuda! Tenho um Projeto para entregar e não estou conseguindo fazer uma macro que exlua linhas de acordo com as seguintes variáveis:

Na aba "FBL3N" na coluna "K" eu tenho os nomes dos navios, eu preciso fazer uma macro que leia na aba "CadastroNavio" na coluna "A" os nomes dos navio e procure na aba "FBL3N" na coluna "K" o navio, se não encontrar delete a linha inteira na aba "FBL3N"

Ou seja:

Macro para excluir linhas na aba "FBL3N" se não encontrar o mesmo nome do navio na aba "CadastroNavio" na coluna "A" (Excluir linhas se estas condições forem aceitas)

Tentei a macro abaixo, mas não consegui, infelizmente não estou compreendendo como fazer
Deus abençoe.
Obrigado.

Option Explicit

Sub ExcluirLinhas()
    Dim i As Long
    Dim UltimaLinha As Long
    
    UltimaLinha = Sheets("FBL3N").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    If UltimaLinha < 2 Then UltimaLinha = 2
    For i = UltimaLinha To 2 Step -1
        If Range("K" & i).Value <> "AFRICAN HHB" Then
        ElseIf Range("K" & i).Value <> "IRMGARD" Then
        ElseIf Range("K" & i).Value <> "ALINDA" Then Rows(i & ":" & i).Select
            Selection.Delete Shift:=xlUp
            Range("A1").Select
           
        
        End If
    Next
    MsgBox "Linhas Excluídas com Sucesso!", vbDefaultButton1, "EXCLUSÃO DE LINHAS"
End Sub

Postado : 14/03/2018 6:02 pm

srobles

(@srobles)

Posts: 231

Estimable Member

TutoElizeu,

Veja se a macro abaixo atende sua demanda.

Sub removeNaoCadastrados()
    Dim nomeNavio As String
    Dim linhaAtual As Long
    Dim ultimaLinha As Long
    Dim excluirLinha As Boolean
    
    linhaAtual = 2
    excluirLinha = False
    
    Application.ScreenUpdating = False
    
    With ThisWorkbook.Sheets("FBL3N")
        .Activate
        
        ultimaLinha = .Cells(Rows.Count, 1).End(xlUp).Row
        
        While linhaAtual <= ultimaLinha '.Cells(linhaAtual, 11) <> "" 'Coluna K
            
            nomeNavio = .Cells(linhaAtual, 11)
            If nomeNavio <> "" Or nomeNavio <> vbNullString Then
                With ThisWorkbook.Sheets("CadastroNavio")
                    Dim pesquisaNavio
                    
                    .Activate
                    
                    Set pesquisaNavio = Nothing
                    With .Range("A:Z")
                    
                        Set pesquisaNavio = .Find(nomeNavio, LookIn:=xlValues, LookAt:=xlWhole)
                            If Not pesquisaNavio Is Nothing Then
                                excluirLinha = False
                            Else
                               excluirLinha = True
                            End If
                    End With
                    Set pesquisaNavio = Nothing
                End With
                
                If excluirLinha = True Then
                    With ThisWorkbook.Sheets("FBL3N")
                        .Activate
                        .Cells(linhaAtual, 11).EntireRow.Delete
                    End With
                    linhaAtual = 2
                Else
                    linhaAtual = linhaAtual + 1
                End If
            Else
                linhaAtual = linhaAtual + 1
            End If
        Wend
        
        MsgBox "Operação realizada com sucesso!", vbInformation, "Remover navios não cadastrados"
        ThisWorkbook.Sheets("FBL3N").Activate
        Application.ScreenUpdating = True
    End With
End Sub

Adicione um botão á planiha FBL3N e associe a ele a macro

Abs

Espero ter ajudado.

Abs.

Saulo Robles

Postado : 14/03/2018 8:08 pm

Osvaldomp

(@osvaldomp)

Posts: 852

Prominent Member

Experimente:

Sub ExcluiNavios()
 Dim navio As Range
  With Sheets("CadastroNavio")
   For Each navio In .Range("A2:A" & .Cells(Rows.Count, 1).End(3).Row)
    If Application.CountIf(Sheets("FBL3N").[k:k], navio.Value) = 0 Then navio.Value = ""
   Next navio
    .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
  End With
End Sub

obs. a coluna A da planilha "CadastroNavio" tem "sujeira invisível" em algumas células o que poderá provocar erro nesta linha .Columns("A").SpecialCells(xlBlanks).EntireRow.Delete. Nesse caso exclua aquela coluna e redigite os dados.

Osvaldo

Postado : 14/03/2018 9:28 pm