Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Tratamento de Erro ...
 
Notifications
Clear all

Tratamento de Erro ao aplicar um filtro + listbox

 
2024 - VBA & Macros
8 Posts
2 Usuários
0 Reactions
1,808 Visualizações
RSS
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Boa tarde,

Estou com dificuldade de fazer o tratamento de um "erro". Basicamente esse é um dos muitos procedimentos de uma userform, mas neste caso específico, tratar o erro caso o CPF não seja encontrado.
Basicamente o que está sendo feito é um filtro em um banco de dados aonde há o histórico de compra do cliente, porém... se o cliente estiver comprando pela primeira vez, esse filtro não irá funcionar, logo quero avisar que ao usuário que este cliente ainda não realizcou uma compra.

Inventei um "teste", que desce a lista de cpfs e conta quantas vezes ele aparece, se ele aparecer pelo menos uma vez entao o código pode seguir em frente, caos contrário mostra a mensagem.

Sub histvend() 'apply filter then gets that client's shopping history
Dim filtrng As Range
Dim filtcpf As Variant
Dim rng As Range
Dim cell As Range

Application.ScreenUpdating = False

filtcpf = UserForm1.TextBox1
filtnome = UserForm1.TextBox2
' AQUI COMEÇA MEU "TESTE"
Sheets("BDNF").Select
Sheets("BDNF").Range("C2").Select
n = 0
Do While ActiveCell <> Empty
    If ActiveCell.Text = filtcpf Then
    n = n + 1
    End If
ActiveCell.Offset(1, 0).Select
Loop
"AQUI ACABA DADO O VALOR OBTIDO SEGUE OU NAO O CÓDIGO DE POPULAR A LISTBOX.

If n <> 0 Then

Sheets("BDNF").Select
Sheets("BDNF").Range("A1").Select
Set filtrng = Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 16384).End(xlToLeft))

With filtrng
    .AutoFilter Field:=3, Criteria1:=filtcpf
    .AutoFilter Field:=113, Criteria1:="<>"
End With

UserForm4.ListBox1.ColumnCount = 5
Set rng = Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).SpecialCells(xlCellTypeVisible)


For Each cell In rng.Cells
With UserForm4.ListBox1
    .AddItem cell.Value
    .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
    .List(.ListCount - 1, 2) = cell.Offset(0, 113).Value
    .List(.ListCount - 1, 3) = cell.Offset(0, 115).Value
    .List(.ListCount - 1, 4) = cell.Offset(0, 125).Value
End With
Next cell
UserForm4.TextBox1 = filtcpf
UserForm4.TextBox2 = filtnome
UserForm4.Caption = "Histórico de Vendas"
UserForm4.Show
Else

MsgBox "Este cliente não foi encontrado na base de vendas. Caso tenha certeza favor informar responsável.", vbExclamation

End If

On Error Resume Next

With filtrng
    .AutoFilter
End With

Application.ScreenUpdating = True
End Sub

Aparentemente está funcionando, mas queria saber se há uma solução mais elegante usando tratamento de erro mesmo ou realizar um loop diferente. Estou questionando mais para aperfeiçoar o código.

Alguém teria algum insight?

Valeu
FJ

 
Postado : 02/07/2013 3:21 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa noite finaljustice,

Fica um pouco difícil sem um modelo, mas vê se ajuda:

Sub histvend() 'apply filter then gets that client's shopping history
Dim filtrng     As Range
Dim filtcpf     As Variant
Dim rng         As Range
Dim cell        As Range
Dim UltL        As Long
Dim wsBDNF      As Worksheets

Set wsBDNF = ThisWorkbook.Worksheets("BDNF")
UltL = wsBDNF.Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

filtcpf = UserForm1.TextBox1
filtnome = UserForm1.TextBox2

'AQUI COMEÇA MEU "TESTE"
If wsBDNF.Range("C" & UltL).Find(what:=filtcpf, LookIn:=Values) Is Nothing Then
    GoTo NaoEncontrado
End If
'AQUI ACABA DADO O VALOR OBTIDO SEGUE OU NAO O CÓDIGO DE POPULAR A LISTBOX.

Sheets("BDNF").Range("A1").Select
Set filtrng = Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 16384).End(xlToLeft))

With filtrng
    .AutoFilter Field:=3, Criteria1:=filtcpf
    .AutoFilter Field:=113, Criteria1:="<>"
End With

UserForm4.ListBox1.ColumnCount = 5
Set rng = Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).SpecialCells(xlCellTypeVisible)


For Each cell In rng.Cells
With UserForm4.ListBox1
    .AddItem cell.Value
    .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
    .List(.ListCount - 1, 2) = cell.Offset(0, 113).Value
    .List(.ListCount - 1, 3) = cell.Offset(0, 115).Value
    .List(.ListCount - 1, 4) = cell.Offset(0, 125).Value
End With
Next cell
UserForm4.TextBox1 = filtcpf
UserForm4.TextBox2 = filtnome
UserForm4.Caption = "Histórico de Vendas"
UserForm4.Show

On Error Resume Next

With filtrng
    .AutoFilter
End With

Application.ScreenUpdating = True

Exit Sub
NaoEncontrado:
MsgBox "Este cliente não foi encontrado na base de vendas. Caso tenha certeza favor informar responsável.", vbExclamation

End Sub

Qualquer coisa da o grito.
Abraço

 
Postado : 02/07/2013 6:07 pm
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Boa noite finaljustice,

Fica um pouco difícil sem um modelo, mas vê se ajuda:

Sub histvend() 'apply filter then gets that client's shopping history
Dim filtrng     As Range
Dim filtcpf     As Variant
Dim rng         As Range
Dim cell        As Range
Dim UltL        As Long
Dim wsBDNF      As Worksheets

Set wsBDNF = ThisWorkbook.Worksheets("BDNF")
UltL = wsBDNF.Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

filtcpf = UserForm1.TextBox1
filtnome = UserForm1.TextBox2

'AQUI COMEÇA MEU "TESTE"
If wsBDNF.Range("C" & UltL).Find(what:=filtcpf, LookIn:=Values) Is Nothing Then
    GoTo NaoEncontrado
End If
'AQUI ACABA DADO O VALOR OBTIDO SEGUE OU NAO O CÓDIGO DE POPULAR A LISTBOX.

Sheets("BDNF").Range("A1").Select
Set filtrng = Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 16384).End(xlToLeft))

With filtrng
    .AutoFilter Field:=3, Criteria1:=filtcpf
    .AutoFilter Field:=113, Criteria1:="<>"
End With

UserForm4.ListBox1.ColumnCount = 5
Set rng = Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).SpecialCells(xlCellTypeVisible)


For Each cell In rng.Cells
With UserForm4.ListBox1
    .AddItem cell.Value
    .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
    .List(.ListCount - 1, 2) = cell.Offset(0, 113).Value
    .List(.ListCount - 1, 3) = cell.Offset(0, 115).Value
    .List(.ListCount - 1, 4) = cell.Offset(0, 125).Value
End With
Next cell
UserForm4.TextBox1 = filtcpf
UserForm4.TextBox2 = filtnome
UserForm4.Caption = "Histórico de Vendas"
UserForm4.Show

On Error Resume Next

With filtrng
    .AutoFilter
End With

Application.ScreenUpdating = True

Exit Sub
NaoEncontrado:
MsgBox "Este cliente não foi encontrado na base de vendas. Caso tenha certeza favor informar responsável.", vbExclamation

End Sub

Qualquer coisa da o grito.
Abraço

Obrigado por responder!

Então estou tendo problemas já na primeira linha:

Set wsBDNF = ThisWorkbook.Worksheets("BDNF")

O erro acontece "Tipos Incompatíveis" e não estou sabendo corrigir.... Me parece que está certo o código, variáveis declaradas...

 
Postado : 03/07/2013 12:08 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde finaljustice,

Altera a declaração da variável de:

Dim wsBDNF      As Worksheets

para

Dim wsBDNF      As Worksheet

Qualquer coisa da o grito.
Abraço

 
Postado : 03/07/2013 12:22 pm
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Boa tarde finaljustice,

Altera a declaração da variável de:

Dim wsBDNF      As Worksheets

para

Dim wsBDNF      As Worksheet

Qualquer coisa da o grito.
Abraço

Opa! Tinha reparado isso agora!
Obrigado!

Estou tendo problemas agora com essa linha:

If wsBDNF.Range("C" & UltL).Find(what:=filtcpf, LookIn:=Values) Is Nothing Then

"Subscrito fora de intervalo"

Basicamente nessa linha vc está definindo O range para realizar um procura ne?

 
Postado : 03/07/2013 12:30 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde,

Opa, deixa assim:

If wsBDNF.Range("C2:C" & UltL).Find(what:=filtcpf, LookIn:=Values) Is Nothing Then

Qualquer coisa da o grito.
Abraço

 
Postado : 03/07/2013 12:52 pm
 finaljustice
(@finaljustice)
Posts: 91
Estimable Member
Topic starter
 

Boa tarde,

Opa, deixa assim:

If wsBDNF.Range("C2:C" & UltL).Find(what:=filtcpf, LookIn:=Values) Is Nothing Then

Qualquer coisa da o grito.
Abraço

Ficou muito bom! Legal, você teve outra abordagem e ficou bem legal!! Valeu mesmo, fiz um pequeno ajuste "xlValues" no find, mas tirando isso, perfeito.
Segue o código completo e corrigido abaixo:

Sub histvend() 'apply filter then gets that client's shopping history
Dim filtrng     As Range
Dim filtcpf     As Variant
Dim rng         As Range
Dim cell        As Range
Dim UltL        As Long
Dim wsBDNF      As Worksheet


Set wsBDNF = ThisWorkbook.Worksheets("BDNF")
UltL = wsBDNF.Range("C" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

filtcpf = UserForm1.TextBox1
filtnome = UserForm1.TextBox2

'AQUI COMEÇA MEU "TESTE"
If wsBDNF.Range("C2:C" & UltL).Find(What:=filtcpf, LookIn:=xlValues) Is Nothing Then
    GoTo NaoEncontrado
End If
'AQUI ACABA DADO O VALOR OBTIDO SEGUE OU NAO O CÓDIGO DE POPULAR A LISTBOX.
wsBDNF.Select
wsBDNF.Range("A1").Select
Set filtrng = Range(Cells(1048576, ActiveCell.Column).End(xlUp), Cells(ActiveCell.Row, 16384).End(xlToLeft))

With filtrng
    .AutoFilter Field:=3, Criteria1:=filtcpf
    .AutoFilter Field:=113, Criteria1:="<>"
End With

UserForm4.ListBox1.ColumnCount = 5
Set rng = Range(ActiveCell, Cells(1048576, ActiveCell.Column).End(xlUp)).SpecialCells(xlCellTypeVisible)


For Each cell In rng.Cells
With UserForm4.ListBox1
    .AddItem cell.Value
    .List(.ListCount - 1, 1) = cell.Offset(0, 1).Value
    .List(.ListCount - 1, 2) = cell.Offset(0, 113).Value
    .List(.ListCount - 1, 3) = cell.Offset(0, 115).Value
    .List(.ListCount - 1, 4) = cell.Offset(0, 125).Value
End With
Next cell
UserForm4.TextBox1 = filtcpf
UserForm4.TextBox2 = filtnome
UserForm4.Caption = "Histórico de Vendas"
UserForm4.Show

On Error Resume Next

With filtrng
    .AutoFilter
End With

Application.ScreenUpdating = True

Exit Sub
NaoEncontrado:
MsgBox "Este cliente não foi encontrado na base de vendas. Caso tenha certeza favor informar responsável.", vbExclamation

End Sub
 
Postado : 03/07/2013 1:13 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

8-)

 
Postado : 03/07/2013 1:15 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico