meu listview é carregado com 6.000 a 7.000 registro, depende do intervalo de datas que quero analisa, mais pelo que percebi na macro do joseA ele me carrega as informações tudo outra vez buscando na planilha, eu não preciso faze mais a busca na planilha se já fiz a busca pelo intervalo de datas e dentro desse intervalos faze a pesquisa por nome que consta dentro do listview

segue o programa que está dando erro mauro coutinho.

http://www.4shared.com/office/6NL7X-gC/ ... pagar.html

Tentando ajudar...

Para teste, insira um ComboBox1 no seu Formulário. No final da instrução do btnFiltrar copie/cole:

Call PreencherComboBox

Copie/cole todas as linhas seguintes no VBA do form:

Private Sub ComboBox1_Change()
Call RemoverItenNome
Call SomarItens
End Sub

Sub PreencherComboBox()
Me.ComboBox1.Clear
    Dim OCOLLECTION As New Collection
Dim VARVALUE As Variant
Dim I, ULTLINHA As Long
    
ULTLINHA = Plan1.[B2].CurrentRegion.Rows.Count
On Error Resume Next
For Each VARVALUE In Plan1.Range("B2:B" & ULTLINHA)
    'Convertemos nomes sem repetir
    OCOLLECTION.Add VARVALUE, VARVALUE
Next
For I = 1 To OCOLLECTION.Count
        ComboBox1.AddItem OCOLLECTION.Item(I)
    Next
Call OrdenarComboBox
End Sub
Sub OrdenarComboBox()
Dim iForsta, iSista As Integer
Dim I, j As Integer
Dim sTemp As String

iForsta = 0
iSista = ComboBox1.ListCount - 1

For I = iForsta To iSista - 1
    For j = I + 1 To iSista
        If ComboBox1.List(I) > ComboBox1.List(j) Then
            sTemp = ComboBox1.List(j)
            ComboBox1.List(j) = ComboBox1.List(I)
            ComboBox1.List(I) = sTemp
        End If
    Next j
Next I
End Sub
Sub RemoverItenNome()
    Dim iLin As Integer
    Dim lCount As Integer
    Dim sCriterio2
    
    If ComboBox1 <> "" Then
        sCriterio2 = ComboBox1
    
        lCount = ListView1.ListItems.Count
    
        For iLin = 1 To lCount
            
            If iLin > lCount Then Exit For
                sTipo = ListView1.ListItems(iLin).ListSubItems(1)
             
                If sTipo <> sCriterio2 Then
                    ListView1.ListItems.Remove iLin
                    iLin = iLin - 1
                    lCount = lCount - 1
                End If
        Next
        
    Else
    
        Call RelatórioForm
    
    End If
    
    Call SomarItens
    
End Sub

Teste aí. Lembrando: pesquise datas e selecione o estabelecimento desejado no ComboBox1.

O joseA fico show de bola agora o programa, funciono tudo certinho..Obrigado!
E Obrigado pela ajuda de todos aqui no forum, vcs são 10

Vlw.

A rotina passada p/ PreencherComBox, filtra diretamente da plan os nomes exclusivos. Ou seja, poderá constar no Combo nomes não contantes no ListView. Para nomes exclusivos do ListView, aquí temos uma instrução que faz um loop pela coluna Nome, diretamente no controle e retorna os exclusivos para o Combo (bastaria substituir - tá quentinha).

Sub PreencherComboBox()
'Por José Arnaldo
    Dim n As Long, texto As Variant
    Me.ComboBox1.Clear
    For n = 1 To ListView1.ListItems.Count
        If Me.ListView1.ListItems(n).ListSubItems(1) = "" Then Exit For
        If InStr(texto, Me.ListView1.ListItems(n).ListSubItems(1)) = 0 Then
            texto = texto & "|" & Me.ListView1.ListItems(n).ListSubItems(1) '& "|"
        End If
    Next
        texto = Split(texto, "|")
    For I = 1 To UBound(texto)
        ComboBox1.AddItem texto(I)
    Next
Call OrdenarComboBox
End Sub

opa joseA essa rotina ai é melhor ainda, já ta funcionando no meu programinha, valeu mesmo por compartilha, vc é gente boa de mais da conta, bom domingo para vc e todos do forum....

Boa noite senhores!!! Vou reabrir o tópico eu acho, mas estou com um pequeno problema em meu filtro ListView.

Vou postar o código que estou usando e também a planilha.
O que acontece é que só consigo buscar por um critério, e já tentei de várias formas mas nada, já peguei alguns exemplos daqui e do fórum do Tomas e também nada,acho que chega um hora que o "Tico e o Teco" batem pino.

Bem chega de papo.

Private Sub cmdopcao_Change()
Me.txtbusca.SetFocus
End Sub
Private Sub UserForm_Initialize()
   
    'Carrega o ListView com as colunas
    With ListView1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .ColumnHeaders.Add Text:="Número", Width:=40      'Número= Nome da 2ª coluna
        .ColumnHeaders.Add Text:="PCP", Width:=60, Alignment:=fmTextAlignCenter   'PCP= Nome da 2ª coluna
        .ColumnHeaders.Add Text:="Ação Imediata", Width:=90, Alignment:=fmTextAlignCenter
        .ColumnHeaders.Add Text:="Necessita Análise?", Width:=90, Alignment:=fmTextAlignCenter 'Necessita Análise= Nome da 3ª coluna
    End With
    'ùltima linha
    lastRow = Plan3.Cells(Rows.Count, "B").End(xlUp).Row
    ' Adiciona itens
    For x = 2 To lastRow
        Set li = ListView1.ListItems.Add(Text:=Plan3.Cells(x, "B").Value)
        li.ListSubItems.Add Text:=Plan3.Cells(x, "AA").Value
        li.ListSubItems.Add Text:=Plan3.Cells(x, "N").Value
        li.ListSubItems.Add Text:=Plan3.Cells(x, "AF").Value
    Next       
End Sub


Private Sub txtbusca_Change()
'Códigos para execução da busca no TextBox
 If Me.cmdopcao.ListIndex = -1 Then
    MsgBox "Selecione um Campo.", 64, "Filtro R.C.Q V.1.0.1" '----->Mensagem exibida quando nenhum dado no combox estiver selecionado
    Me.txtbusca = ""
  Exit Sub
End If
Dim strObjetoBuscar As String
Dim lngResultado As Integer
Dim lngColumna As Long, lngFila As Long
Dim a As Integer
ListView1.ListItems.Clear
strObjetoBuscar = txtbusca.Value
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
    For a = 2 To 2010
  
        lngResultado = InStr(1, Plan3.Cells(a, 2), strObjetoBuscar, vbTextCompare) ' Se eu selecionar mais de um item este não é chamado!!!!!
        'lngResultado = InStr(1, Plan3.Cells(a, 27), strObjetoBuscar, vbTextCompare) ' Os números são das colunas onde estão os dados!!!        
        'lngResultado = InStr(1, Plan3.Cells(a, 14), strObjetoBuscar, vbTextCompare)
        'lngResultado = InStr(1, Plan3.Cells(a, 32), strObjetoBuscar, vbTextCompare)

            If lngResultado > 0 Then
             Set li = ListView1.ListItems.Add(Text:=Format(Plan3.Range("B" & a).Value, "00"))
                 li.ListSubItems.Add Text:=Plan3.Range("AA" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("N" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("AF" & a).Value
            End If
    Next a
99:
End Sub

Senhores desde já agradeço a quem puder me ajudar, imagino que seja algo bem simples que estou fazendo errado.
Obrigado.

Sua busca es´ta fixa na coluna 27, para que varia é necessario fornecer qual a coluna a ser pesquisada.
Veja se atende conforme a modificação :

Private Sub txtbusca_Change()
Dim strObjetoBuscar As Variant
Dim lngResultado As Integer, a As Integer
Dim lngColumna As Long, lngFila As Long
'Códigos para execução da busca no TextBox
 
 Select Case cmdopcao.ListIndex
    Case -1
 'If Me.cmdopcao.ListIndex = -1 Then
    MsgBox "Selecione um Campo.", 64, "Filtro R.C.Q V.1.0.1" '----->Mensagem exibida quando nenhum dado no combox estiver selecionado
    Me.txtbusca = ""
  Exit Sub
'End If
    Case 0
    lngColumna = Range("B" & 1).Column
    Case 1
    lngColumna = Range("AA" & 1).Column
    Case 2
    lngColumna = Range("N" & 1).Column
    Case 3
    lngColumna = Range("AF" & 1).Column
 End Select

ListView1.ListItems.Clear
strObjetoBuscar = txtbusca.Value
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
    For a = 2 To 2010
  
        'lngResultado = InStr(1, Plan3.Cells(a, 2), strObjetoBuscar, vbTextCompare)
        lngResultado = InStr(1, Plan3.Cells(a, lngColumna), strObjetoBuscar, vbTextCompare)
        
        'lngResultado = InStr(1, Plan3.Cells(a, 14), strObjetoBuscar, vbTextCompare)
        'lngResultado = InStr(1, Plan3.Cells(a, 32), strObjetoBuscar, vbTextCompare)

            If lngResultado > 0 Then
             Set li = ListView1.ListItems.Add(Text:=Format(Plan3.Range("B" & a).Value, "00"))
                 li.ListSubItems.Add Text:=Plan3.Range("AA" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("N" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("AF" & a).Value
            End If
    Next a
99:
End Sub

Sua busca es´ta fixa na coluna 27, para que varia é necessario fornecer qual a coluna a ser pesquisada.
Veja se atende conforme a modificação :

Private Sub txtbusca_Change()
Dim strObjetoBuscar As Variant
Dim lngResultado As Integer, a As Integer
Dim lngColumna As Long, lngFila As Long
'Códigos para execução da busca no TextBox
 
 Select Case cmdopcao.ListIndex
    Case -1
 'If Me.cmdopcao.ListIndex = -1 Then
    MsgBox "Selecione um Campo.", 64, "Filtro R.C.Q V.1.0.1" '----->Mensagem exibida quando nenhum dado no combox estiver selecionado
    Me.txtbusca = ""
  Exit Sub
'End If
    Case 0
    lngColumna = Range("B" & 1).Column
    Case 1
    lngColumna = Range("AA" & 1).Column
    Case 2
    lngColumna = Range("N" & 1).Column
    Case 3
    lngColumna = Range("AF" & 1).Column
 End Select

ListView1.ListItems.Clear
strObjetoBuscar = txtbusca.Value
If strObjetoBuscar = "" Then GoTo 99
strObjetoBuscar = LCase(strObjetoBuscar)
    For a = 2 To 2010
  
        'lngResultado = InStr(1, Plan3.Cells(a, 2), strObjetoBuscar, vbTextCompare)
        lngResultado = InStr(1, Plan3.Cells(a, lngColumna), strObjetoBuscar, vbTextCompare)
        
        'lngResultado = InStr(1, Plan3.Cells(a, 14), strObjetoBuscar, vbTextCompare)
        'lngResultado = InStr(1, Plan3.Cells(a, 32), strObjetoBuscar, vbTextCompare)

            If lngResultado > 0 Then
             Set li = ListView1.ListItems.Add(Text:=Format(Plan3.Range("B" & a).Value, "00"))
                 li.ListSubItems.Add Text:=Plan3.Range("AA" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("N" & a).Value
                 li.ListSubItems.Add Text:=Plan3.Range("AF" & a).Value
            End If
    Next a
99:
End Sub

Reinaldo!!!

Perfeito sua rotina, cara já vinha tendo dores de cabeça com esse código, pois como não tenho muita intimidade ainda com o VBA, imaginava que era algo do tipo, nomear o intervalo, mas não tinha noção de como fazer isso.

Muito obrigado por ter resolvido meu problema.

Um forte abraço.