Este fórum está sendo desativado

[AMORIM123]

Olá, galera boa tarde.

Estou com probleminha que não estou conseguindo ler nas entrelinhas do meu código..rsrsr. Seguinte, No código a baixo tenho a instrução do meu "btn_pesquisar" do UserForm1, basicamente ele limpa minha "wshFiltro" para receber o filtro feito nos dados da "wshBanco", isso é feito por meio de "Do Until" para escolher (Like) entre o que esta na planilha com o que está nos txtbox em seguida ele remete tudo que for encontrado para a "wshFiltro" através do "For", porém, meu problema está nesta última parte, na instrução do loop ele compara os lavores nos txtbox's com o que está na planilha e escolhe "Like", porém não entra na instrução "For" para passar para wshFiltro, não entendo o por quê?!

Já revisei e revisei e revisei e não estou conseguindo obter exito em identificar, até mesmo é código que tenho prática em utiliza-lo em outros projetos funciona lega, porém neste projeto não roda...já comparei e nada.

Código: Selecionar todos

Private Sub btn_pesquisar_Click()
    
Dim linhaBanco      As Integer
Dim linhaFiltro     As Integer
Dim lngUltLin       As Long
Dim vrtPerInf       As Variant
Dim vrtPerSup       As Variant
Dim IntCol          As Integer



Application.ScreenUpdating = False


On Error GoTo erro
linhaBanco = 2
linhaFiltro = 15


With wshFiltro

    wshFiltro.Activate
    
    lngUltLin = .Cells(.Rows.Count, 1).End(xlUp).Row
    
    If lngUltLin + 1 >= linhaFiltro Then .Range(.Cells(linhaFiltro, 1), .Cells(lngUltLin + 1, 32)).ClearContents

End With



vrtPerInf = CDate(IIf(txt_comp1.Value = "", 0, txt_comp1.Value))
vrtPerSup = CDate(IIf(txt_comp2.Value = "", 1000000, txt_comp2.Value))




With wshBanco

    wshBanco.Activate
    
    Do Until .Cells(linhaBanco, 1).Value2 = ""
        
        If UCase(.Cells(linhaBanco, 3).Value2) Like "*" & UCase(txt_remetente.Value) & "*" And _
        UCase(.Cells(linhaBanco, 2).Value2) Like "*" & UCase(txt_nota.Value) & "*" And _
        UCase(.Cells(linhaBanco, 24).Value2) Like "*" & UCase(txt_num_selo.Value) & "*" And _
        UCase(.Cells(linhaBanco, 28).Value2) Like "*" & UCase(cb_deferimento.Value) & "*" And _
        UCase(.Cells(linhaBanco, 25).Value2) Like "*" & UCase(txt_processo.Value) & "*" And _
        UCase(.Cells(linhaBanco, 30).Value2) Like "*" & UCase(cb_tipo_processo.Value) & "*" And _
        UCase(.Cells(linhaBanco, 31).Value2) Like "*" & UCase(cb_status.Value) & "*" And _
        .Cells(linhaBanco, 5).Value2 >= vrtPerInf And _
        .Cells(linhaBanco, 5).Value2 <= vrtPerSup Then
        
            For IntCol = 1 To 32
                wshFiltro.Cells(linhaFiltro, IntCol) = .Cells(linhaBanco, IntCol)
            Next IntCol
                
                linhaFiltro = linhaFiltro + 1
        End If
                linhaBanco = linhaBanco + 1
                
    Loop
    
    wshFiltro.Activate
    
End With

Call carregarlistbox


Application.ScreenUpdating = True

'É BOA PRÁTICA NOS PROCEDIMENTOS DE TRATAMENTO DE ERROS, POR COMO LINHA DE DESTINO O FINAL DA INSTRUÇÃO DO PROCEDIMENTO
'E ANTES DESSA LINHA POR "EXIT SUB", POIS CASO SEJA APRESENTADO ERRO AO EXECUTAR O CÓD ELE NÃO EXECUTA A LINHA DE
'TRATAMENTO DE ERRO
Exit Sub
erro:
Application.ScreenUpdating = True

End Sub

Quem puder me ajudar....serei muito grato.

Caso tenha algum problema para acessar a planilha, pois o form oculta a interface do excel, basta dar um duploclick no canto inferior esquerdo do "MULTI-PAGE"

Muito obrigado pelo tempo e conhecimento dispêndido!

[AMORIM123]

Meu problema parece ser nas seguintes linhas:

Código: Selecionar todos

vrtPerInf = CDate(IIf(txt_comp1.Value = "", 0, txt_comp1.Value))
vrtPerSup = CDate(IIf(txt_comp2.Value = "", 1000000, txt_comp2.Value))

            *
            *
            *
 Do Until .Cells(linhaBanco, 1).Value2 = ""
        
        If UCase( ......

        .Cells(linhaBanco, 5).Value2 >= vrtPerInf And _
        .Cells(linhaBanco, 5).Value2 <= vrtPerSup Then

Ao depurar o código havia identificado que ele não loopa o "FOR", porém quando comento as linhas acima, que são utilizadas para retornar um intervalo entre datas, elas retornam a busca na wshBanco transferindo o filtro realizado para wshFiltro e em seguida para o listbox2 do UserForm1; Identifiquei que as propriedades da coluna não estavam formatadas para data e o tipo de dados das variáveis "vrtPerInf" e "vrtPerSup" não estavam com o tipo correto, pôs "Date" e consegui, obter o esperado...se bem que os tipo das variáveis "vrtPerInf" e "vrtPerSup" estavam a definir, "As Variant", enfim, deu certo!, mas vou procurar entender o por quê!

[Reinaldo]

CrossPost http://www.planilhando.com.br/forum/vie ... 10&t=29763

Experimente:
Ajuste no evento inicializar do UserForm1

Código: Selecionar todos

Private Sub UserForm_Initialize()
'--------------------------------------------------------------------------------------------------------------------
With wshOculta
    wshOculta.Activate
    .Cells(2, 5).Select
    UserForm1.cb_tipo_processo.Clear
        Do While ActiveCell.Value <> ""
            UserForm1.cb_tipo_processo.AddItem ActiveCell.Value
            ActiveCell.Offset(1, 0).Select
        Loop
'---------------------------------------------------------------------------------------------------------------------
    .Cells(2, 7).Select
    UserForm1.cb_deferimento.Clear
        Do While ActiveCell.Value <> ""
            UserForm1.cb_deferimento.AddItem ActiveCell.Value
            ActiveCell.Offset(1, 0).Select
        Loop
'---------------------------------------------------------------------------------------------------------------------
    .Cells(2, 9).Select
    UserForm1.cb_status.Clear
        Do While ActiveCell <> ""
            UserForm1.cb_status.AddItem ActiveCell.Value
            ActiveCell.Offset(1, 0).Select
        Loop
End With
End Sub

Alteração na rotina btn_pesquisar

Código: Selecionar todos

Private Sub btn_pesquisar_Click()
Dim linhaBanco      As Integer
Dim linhaFiltro     As Integer
Dim lngUltLin       As Long
Dim vrtPerInf       As Date
Dim vrtPerSup       As Date
Dim IntCol          As Integer

Application.ScreenUpdating = False

On Error GoTo erro
linhaBanco = 2
linhaFiltro = 15

With wshFiltro
    lngUltLin = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lngUltLin + 1 >= linhaFiltro Then .Range(.Cells(linhaFiltro, 1), .Cells(lngUltLin + 1, 32)).ClearContents
End With

If (txt_comp1.Text) <> "" Then
    vrtPerInf = CDate(txt_comp1.Text)
Else
    vrtPerInf = CDate("31/1/1901")
End If
If (txt_comp2.Text) <> "" Then
    vrtPerSup = CDate(txt_comp2.Text)
Else
    vrtPerSup = CDate("31/12/2099")
End If

With wshBanco
    Do Until .Cells(linhaBanco, 1).Value2 = ""
        If UCase(.Cells(linhaBanco, 3).Value2) Like "*" & UCase(txt_remetente.Value) & "*" And _
           UCase(.Cells(linhaBanco, 2).Value2) Like "*" & UCase(txt_nota.Value) & "*" And _
           UCase(.Cells(linhaBanco, 24).Value2) Like "*" & UCase(txt_num_selo.Value) & "*" And _
           UCase(.Cells(linhaBanco, 28).Value2) Like "*" & UCase(cb_deferimento.Value) & "*" And _
           UCase(.Cells(linhaBanco, 25).Value2) Like "*" & UCase(txt_processo.Value) & "*" And _
           UCase(.Cells(linhaBanco, 30).Value2) Like "*" & UCase(cb_tipo_processo.Value) & "*" And _
           UCase(.Cells(linhaBanco, 31).Value2) Like "*" & UCase(cb_status.Value) & "*" And _
           .Cells(linhaBanco, 5).Value2 >= vrtPerInf And _
           .Cells(linhaBanco, 5).Value2 <= vrtPerSup Then
                
                For IntCol = 1 To 32
                    wshFiltro.Cells(linhaFiltro, IntCol) = .Cells(linhaBanco, IntCol)
                Next IntCol
                linhaFiltro = linhaFiltro + 1
        End If
                linhaBanco = linhaBanco + 1
    Loop
    wshFiltro.Activate
End With
Call carregarlistbox
Application.ScreenUpdating = True

'É BOA PRÁTICA NOS PROCEDIMENTOS DE TRATAMENTO DE ERROS, POR COMO LINHA DE DESTINO O FINAL DA INSTRUÇÃO DO PROCEDIMENTO
'E ANTES DESSA LINHA POR "EXIT SUB", POIS CASO SEJA APRESENTADO ERRO AO EXECUTAR O CÓD ELE NÃO EXECUTA A LINHA DE
'TRATAMENTO DE ERRO
Exit Sub
erro:
Application.ScreenUpdating = True

End Sub