Excel Carregamento lento de listbox

[josequali]

Bom dia @LaerteB @Midori

Atualmente venho enfrentando a seguinte situação.

Trabalho com uma planilha que tem mais de 10 mil linhas e com colunas que variam entre 20 a 80 colunas.
O meu problema é o seguinte: quando preciso realizar uma pesquisa no meu banco de dados usando a
minha listbox para obter alguma informação, o carregamento torna-se muito lento e acaba travando,
devido ao carregamento das informações ocorrer a medida que vou digitando ou apagando o campo da minha textbox.
Procurei alguns modelos de planilha com botão de pesquisa associado a uma textbox, mas só achei modelos com até 10 colunas.
Gostaria de saber como poderia resolver esse empasse. Qual seria a melhor solução. Segue em anexo o modelo do projeto.

Desde já agradeço a ajuda de todos. Obrigado :).
 

 

modelo.rar

[RafaVillani]

Ola, vi um vídeo no youtube algum tempo atras que carregava 300 mil linhas em 2 segundos, e utilizava um sistema de filtros bem rápido. Procure por carregar listbox 600 vezes mais rápido, o vídeo é longo, mais ou menos, uma hora de duração, mas acho que lhe atende.

[josequali]

@RafaVillani Obrigado! Entretanto, o modelo dele usa pouca colunas. O meu tem várias  

[Midori]

@josequali  Os IDs da planilha Documento vão de 1 a 9 e todos se repetem diversas vezes. Tem que ser assim mesmo? Essa planilha está com mais 2000 linhas, se tirar os repetidos ou limitar a quantidade de IDs na busca vai ficar mais rápido já que serão só 9 para pesquisar.

[josequali]

@Midori eram dados aleatórios, só para preencher, por isso estão repetidos....Eu removi os originais. É porque a maioria das minha planilhas tem mais de 10 mil linhas.

[Midori]

@josequali  Use a função Find para pesquisar em vez de loop. Aí só terá que passar os valores  da busca e não terá necessidade de um contador.

[josequali]

@Midori como seria?

[Midori]

@josequali  Agora vi que na pesquisa o seu listbox deve ser atualizado dinamicamente. Então acho que o melhor é fazer como o @RafaVillani comentou e usar o auto filtro.

 

Para deixar a pesquisa mais rápida o ideal é evitar loops e para isso terá que carregar o listbox só com RowSource.

 

Quando efetuar uma pesquisa, a macro vai filtrar a planilha de acordo com o critério da busca (ID, Status, etc), copiar a tabela filtrada para uma planilha auxiliar e carregar novamente o ListBox atribuindo o RowSource com essa tabela auxiliar, p.ex,

 

Para filtrar a tabela de acordo com o valor da busca e a coluna,

 

O parâmetro Coluna é o número da coluna na planilha, p.ex ID é a coluna 1, Status é a coluna 11.

 

Sub FiltrarPlanilha(Valor As String, Coluna As Integer)
    Dim Area As Range
    Set Area = ThisWorkbook.Sheets("Documentos").Range("A2:AC2")
        Area.AutoFilter Field:=Coluna, Criteria1:=Valor
End Sub

 

Copiar as células filtradas para uma planilha auxiliar,

Sub CopiaFiltro()
    L = ThisWorkbook.Sheets("Documentos").[A2].End(xlDown).Row
    ThisWorkbook.Sheets("AUX").[A:K].Clear
    ThisWorkbook.Sheets("Documentos").Range("A2:K" & L).Copy
    ThisWorkbook.Sheets("AUX").[A1].PasteSpecial
End Sub

 

E para carregar/atualizar o ListBox,

 

Sub CarregaListBox(Lista As Object, Optional Filtro As Boolean = False)
    If Filtro = False Then
        L = ThisWorkbook.Sheets("Documentos").[A2].End(xlDown).Row
        Lista.RowSource = "Documentos!A3:K" & L
    Else
        L = ThisWorkbook.Sheets("AUX").[A2].End(xlDown).Row
        Lista.RowSource = ""
        Lista.RowSource = "AUX!A2:K" & L
    End If
End Sub

 

[josequali]

@Midori Tentei fazer as alterações mas não deu certo. Removi do meu projeto os códigos que não preciso agora e só deixei os que estão envolvidos na pesquisa e na filtragem da listbox1. Poderia me auxiliar na troca de código. Não entendi muito bem  onde alterar. Desde já, agradeço a disponibilidade  

modelo.rar

[josequali]

@Midori @LaerteB  

[Midori]

@josequali  Cole estas macros no módulo,

 

Option Explicit

Private L As Long

Public Const FILTRO_ID  As Integer = 1
Public Const FILTRO_PROCESSO As Integer = 2
Public Const FILTRO_STATUS = 11

Sub LimpaFiltro()
    [A2:AC2].AutoFilter
    [A2:AC2].AutoFilter
End Sub

Sub FiltraPlanilha(Valor As String, Coluna As Integer)
    Dim Area As Range
    
    Set Area = ThisWorkbook.Sheets("Documentos").Range("A2:AC2")
        Area.AutoFilter Field:=Coluna, Criteria1:=Valor
End Sub

Sub CopiaFiltro()
    L = ThisWorkbook.Sheets("Documentos").[A2].End(xlDown).Row
    ThisWorkbook.Sheets("AUX").[A:K].Clear
    ThisWorkbook.Sheets("Documentos").Range("A2:K" & L).Copy
    ThisWorkbook.Sheets("AUX").[A1].PasteSpecial xlPasteValues
    Application.CutCopyMode = False
End Sub

Sub CarregaListBox(Lista As Object, Optional Filtro As Boolean = False)
    If Filtro = False Then
        L = ThisWorkbook.Sheets("Documentos").[A2].End(xlDown).Row
        Lista.RowSource = "Documentos!A3:K" & L
    Else
        L = ThisWorkbook.Sheets("AUX").[A2].End(xlDown).Row
        Lista.RowSource = ""
        Lista.RowSource = "AUX!A2:K" & L
    End If
End Sub

 

Este no evento Initialize do formulário,

 

Call CarregaListBox(form_documentos.ListBox1)

 

 

Tire todas as macros do evento Click dos options e do evento Change do TextoBox1 (da pesquisa).

 

E cole esta no formulário.

 

A pesquisa será feita quando um option estiver selecionado e ao digitar enter.

 

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim Coluna As Integer
    
    If KeyCode = 13 Then
        If opt_id.Value = True Then Coluna = FILTRO_ID
        If opt_status.Value = True Then Coluna = FILTRO_STATUS
        If opt_tipodedoc.Value = True Then Coluna = FILTRO_PROCESSO
        
        If Coluna <> 0 Then
            Dim Pesquisa As String
            If Coluna = FILTRO_ID Then
                Pesquisa = TextBox1.Text
            Else
                Pesquisa = "*" & TextBox1.Text & "*"
            End If
            
            Call LimpaFiltro
            Call FiltraPlanilha(Pesquisa, Coluna)
            Call CopiaFiltro
            Call CarregaListBox(Me.ListBox1, True)
        End If
    End If
End Sub

 

[josequali]

@Midori Boa tarde! Fiz tudo como indicado, consegui carregar as informações de forma ágil,  . Entretanto, perdi todas as configurações do cabeçario, além de que ele não carrega as informações de todas as colunas. O que será que aconteceu?  Desde já agradeço pela ajuda e disponibilidade. Obrigado!

 

[josequali]

Em 19/03/2021 às 17:42, josequali disse:

@Midori  @RafaVillaniBoa tarde!  . Consegui adaptar os códigos. Obrigado