Ir ao conteúdo

Posts recomendados

Postado

Estou com um código que funciona perfeitamente, porém quando o método .find encontra mais de um erro, ele trava. Tentei diversas dicas porém não consegui retirar esse erro do meu código. A linha com erro deixei destacada com ***

Sub filtro()
'

'
Application.ScreenUpdating = False

    On Error GoTo revisar

'retirar plantas vazias
    Range("A2").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$2:$U$4500").AutoFilter Field:=18, Criteria1:="="
    Rows("3:3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
'retirar LH
    ActiveSheet.Range("$A$1:$U$4500").AutoFilter Field:=1, Criteria1:="=lr*", _
        Operator:=xlAnd
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
'retirar B3 e B5
    ActiveSheet.Range("$A$2:$U$4500").AutoFilter Field:=18, Criteria1:=Array( _
        "B3", "B3, B5", "B5"), Operator:=xlFilterValues
    Selection.Delete Shift:=xlUp
    ActiveSheet.ShowAllData
'filtrar rotas a confirmar
    ActiveSheet.Range("$A$2:$U$4500").AutoFilter Field:=2, Criteria1:= _
        "A CONFIRMAR"
    
'copiar nomenclaturas para a coluna W
    Range("A2").Select
        Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range("W2").Select
    ActiveSheet.Paste

'remover duplicadas de nomenclatura
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    ActiveSheet.Range("$W$2:$W$300").RemoveDuplicates Columns:=1, Header:=xlYes


'retirar dados desnecessários do EDI
    Sheets("EDI").Select
    Range("B:B,E:E,H:H,J:J,L:L,K:K,M:Z,AB:AB,AE:AE,AG:AG,AI:AI,AL:BU").Select
    Selection.Delete Shift:=xlToLeft
    Sheets("EDI").Range("A1").Select
    
    Sheets("Book").Select
    
'variáveis
    linha_fim = Sheets("Book").Range("W2").End(xlDown).Row
    linha = 3
    
    
'criação de abas para cada nomenclatura a confirmar
While linha <= linha_fim

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = Sheets("Book").Cells(linha, 23)
    
    Sheets("EDI").Range("A1:M1").Copy
    ActiveSheet.Range("A1").PasteSpecial
    nomenclatura = Sheets("Book").Cells(linha, 23).Value



   *** busca = Sheets("EDI").Cells.Find(nomenclatura, , , xlWhole).Row***


    nom_edi = Sheets("EDI").Cells(busca, 2).Value
    aba_linha = 2
    
    While nom_edi = nomenclatura
        Sheets("EDI").Range("A" & busca & ":M" & busca).Copy
        
        ActiveSheet.Cells(aba_linha, 1).PasteSpecial
        
        busca = busca + 1
        aba_linha = aba_linha + 1
        nom_edi = Sheets("EDI").Cells(busca, 2).Value
    Wend

linha = linha + 1

Wend

Sheets("Book").Select

Range(Cells(2, 23), Cells(linha_fim, 23)).Clear
Range("A2").Select

ThisWorkbook.Save

MsgBox "As Rotas a Confirmar Foram Separadas Por Abas Com Sucesso!", vbInformation
Application.ScreenUpdating = True
End Sub

 

  • Curtir 1
Postado

Olá, @Marcelo Almeida Cruz

Em 01/07/2020 às 06:40, Marcelo Almeida Cruz disse:

*** busca = Sheets("EDI").Cells.Find(nomenclatura, , , xlWhole).Row***

 

O método Find retorna um objeto tipo Range. Só que quando não encontra nada, o objeto retornado por ele também não tem conteúdo, permanecendo então com o valor especial Nothing. O erro então irá ocorrer porque você tenta ler a propriedade .Row desse Nothing.

Você poderia atribuir o retorno a uma variável Range e então testar: se é Nothing nada foi encontrado, exibe uma mensagem e sai, por exemplo. Senão é porque encontrou então põe a propriedade Row na variável busca:

 

  Set rg = Sheets("EDI").Cells.Find(nomenclatura, , , xlWhole)
  If rg Is Nothing Then
    MsgBox "Não encontrado"
    Exit Sub
  Else
    busca = rg.Row
  End If

 

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

LANÇAMENTO!

eletronica2025-popup.jpg


CLIQUE AQUI E BAIXE AGORA MESMO!