[Resolvido]Desempenho de filtro composto em sub-formulário folha de dados

Boa tarde a todos!

Montei um sistema de estoque de chapas de uma empresa de granitos. Tenho uma formulário de Estoque de Cavaletes (pallets) (formEstoqueCavaletes) e neste um sub-formulário em folha de dados (subCavalete). No formulário principal tenho vários campos de filtro, que filtram além dos dados dos cavaletes, também informações das chapas que compõe cada cavalete (como número do bloco, defeitos, material, etc) retiradas da tabela tblCadastroChapa. O campo comum entre as duas tabelas é o cavalete (numérico).

Do jeito que fiz ele verifica todos os campos que foram preenchidos, monta uma string que usa para verificar, através de um recordset, na tblCadastroChapa as chapas que atendem ao requisito. Agrupa-se pelos cavaletes e usa esses cavaletes como base para marcar o campo "selConsulta" do sub-formulário subCavalete. Então aplico a propriedade .filter no subCavalete para mostrar apenas os registros que tenham o "selConsulta" marcado como True.

Esse método é funcional. Porém o meu problema é de Desempenho, demora DEMAIS para fazer todo esse loop em cada filtragem.

Tenho certeza que o problema é que eu uso campo de duas tabelas para fazer a consulta, e isso demora na hora de marcar o campo "selConsulta". Mas não sei como montar o filtro, uma vez que não posso ter todos os campos da tblCadastroChapa no subCavalete, pois é muitos para um (respectivamente).

Abaixo um print dos campos de filtro. Excetuando-se os campos Cavalete e Packing List, todos os outros da fileira de baixo são da tblCadastroChapa.



Espero ter me feito entender. Obrigado a todo que se disponibilizar a ajudar de qualquer maneira.

Abraço.

Quais os campos desta imagem que são da (formEstoqueCavaletes) e quais os campos que são do sub (subCavalete)? Esta sua imagem é baseado em uma tabela ou uma consulta? se puder postar apenas estes objetos envolvidos para melhor compreensão dos fatos, conseguiremos te auxiliar melhor.

Bom dia,

Os campos Bloco, Material, Avulso, Qualidade, Defeito e Esp., se preenchidos, montam uma string que faz a consulta na tblCadastroChapa. O formulário principal da imagem é o formEstoqueCavalete e a folha de dados é o subCavalete (acoplado à tblCavalete). Abaixo o trecho do código que faz a consulta. Talvez assim fique mais facil de ver onde está o erro. Obrigado.

Public Function filtraRegistros()
   Dim sitTitulos      As Boolean
   Dim selEmpresa      As String
   Dim dataInicial, dataFinal, dataHoje
   Dim strConsulta As String
   Dim strCampos As String
   
   Call limpaPesquisaMaterial
   Call limpaTemporario
       
   cbxRelacaoChapas.Requery
   
   If selTodasEmpresas = True Then
       selEmpresa = False
   Else
       selEmpresa = getEmpresaAtual
   End If
       
   If Me.qdSitTitulos = 1 Then
       filtro = "baixado = false"
       setSitTitulo ("emAberto")
   Else
       filtro = "baixado = true"
       setSitTitulo ("baixado")
   End If
   
   strConsulta = "ativo = true"
   
       If Not IsNull(txtBloco) = True Then
           strConsulta = strConsulta & " and numerobloco = " & txtBloco & ""
           strCampos = "numerobloco, "
       End If
       
       If cbxQualidade <> "*" Then
           strConsulta = strConsulta & " and codigoclassificacao = " & cbxQualidade.Column(1) & ""
           strCampos = strCampos & "codigoclassificacao, "
       End If
       
       If cbxPackingList <> "*" Then
           strConsulta = strConsulta & " and packinglist = '" & cbxPackingList.Column(0) & "'"
           strCampos = strCampos & "packinglist, "
       End If
       
       If selAvulso = True Then
           strConsulta = strConsulta & " and packinglist = ''"
       End If
       
       If Not IsNull(txtDefeito) = True Then
           strConsulta = strConsulta & " and defeito like '*" & txtDefeito & "*'"
           strCampos = strCampos & "defeito, "
       End If
       
       If Not IsNull(txtEspessura) = True Then
           strConsulta = strConsulta & " and espessura = " & txtEspessura & ""
           strCampos = strCampos & "espessura"
       End If
       
       'faz a pesquisa
       Dim rsConsulta As Recordset
       
       Set db = CurrentDb
       Set rs = db.OpenRecordset("SELECT distinct '" & strCampos & "', cavalete, ativo FROM tblCadastroChapa WHERE " & strConsulta & " GROUP BY cavalete, '" & strCampos & "', ativo")

       If rs.RecordCount > 0 Then
               Do While Not rs.EOF
                   If Not rs!cavalete = "" Then
                       Set rsConsulta = db.OpenRecordset("select * from tblCavalete WHERE cavalete = " & rs!cavalete & "")
                       
                       If rsConsulta.RecordCount > 0 Then
                           rsConsulta.Edit
                               rsConsulta("selconsulta") = True
                           rsConsulta.Update
                       End If
                   End If
                   
                   rs.MoveNext
               Loop
   
           rs.Close
       End If
       
       filtro = filtro & " and selconsulta = true"
           
       If Not IsNull(txtCavalete) = True Then
           filtro = filtro & " and cavalete = " & txtCavalete & ""
       End If
       
       If cbxMaterial <> "*" Then
           filtro = filtro & " and codigomaterialcavalete = " & cbxMaterial.Column(2) & ""
       End If
       
       Select Case qdReserva
           Case 1
               filtro = filtro & " and reservado = true"
           Case 2
               filtro = filtro & " and reservado = false"
       End Select
               
       If cbxClienteReserva <> "*" Then
           filtro = filtro & " and codigoclientereserva = " & cbxClienteReserva.Column(2) & ""
       End If
       
       dataInicial = Format(txtDataInicial, "mm/dd/yyyy")
       dataFinal = Format(txtDataFinal, "mm/dd/yyyy")
       dataHoje = Format(getDataHoje, "mm/dd/yyyy")
       
       Select Case Me.qdOptFiltro
           Case 1 'lançamento
               filtro = filtro & " and datalancamento Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
               
               
               subCavalete.Form.Filter = filtro
               subCavalete.Form.FilterOn = True
               subCavalete.Requery
           Case 2 'baixa
               filtro = filtro & " and baixadoem Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
               
               
               subCavalete.Form.Filter = filtro
               subCavalete.Form.FilterOn = True
               subCavalete.Requery
           Case 3 'todos
               filtro = filtro & " and ativo = true"
               
               subCavalete.Form.Filter = filtro
               subCavalete.Form.FilterOn = True
               subCavalete.Requery
       End Select
End Function

Olá Cassio Fabre,
Realmente da forma que está se a base de dados "inchar" não sei, além se for em rede como será.

Seria mais fácil postar base de dados com formulario (e todos os obejectos dependentes) e dados de amostragem para se testar.
Assim fica mais fácil para qualquer membro poder ajudar.

Não sou especialista em consultas, mas creio que poderia fazer ao invocar a origem dos dados, incluindo na propria consulta SQL

Código:

Set rs = db.OpenRecordset("SELECT distinct '" & strCampos & "', cavalete, ativo FROM tblCadastroChapa WHERE " & strConsulta & " GROUP BY cavalete, '" & strCampos & "', ativo")

Abraço

Bom dia,

Segue os objetos relacionados, realmente não sei como melhorar esse código do ponto de vista do desempenho. Agradeço qualquer ajuda.

Abraço.

Olá, assim que disponha de um tempinho verifico.
Ainda nem baixei, mas será mais fácil para ajudar.
Abraço

Olá Cassio, tem 3 tabelas vinculadas.
Carregue novamente exmplo com as tabelas importados, como no outro tópico.
Abraço

Bom dia,

Atualizei o arquivo da mensagem anterior.

Abraço.

Olá Cassio, obrigado.
Assim que tenha um tempinho, irei verificar se posso ajudar.
Abraço

Bom dia,

No aguardo.

Abraço.

Olá, não está esquecido.
Apenas falta de tempo para estudar seu código e testar.
Abraço

Bom dia,

Tudo bem ahteixeira, também estou um tanto quanto atarefado aqui. Mas estou à procura de soluções também, caso eu as encontre primeiro, rapidamente compartilharei, até lá estou no aguardo.

Abraço.

Olá Cassio Fabre,
Hoje arranjei um tempinho e esive a verificar.
Faz mais que uma consulta.
Iniciei a verificação da caixa de listagem no rodapé.
Não tenho a certeza, mas acho que não é necessário uma tabela temporária.
Acho que se consegue obter o mesmo resultado por uma consulta.
Irei testar e posto.

Quanto à consulta do sub formulário, fiquei com algumas dúvidas, em especial qual a razão do campo para selecionar. Pode explicar melhor.
Abraço

Boa tarde,

Primeiramente obrigado pelo retorno.

Quanto à tabela temporária, já havia verificado isso em versões posteriores do sistema, hoje utilizo apenas uma caixa de combinação e a populo via .RecordSource em tempo de execução, já exclui essa tabela temporária.

O campo para selecionar eu uso apenas para marcar os lançamentos que serão alterados com cada ação. Por exemplo, posso querer editar os cavaletes de numero 1, 2, 3 e 4, então vou e marco esse campo e clico no botão Editar Cavalete, abre o formulário de edição com esses quatro registros selecionados. Na versão completa do sistema, todas as ações são controladas pela Ribbon, como não era o foco da questão deste tópico, acabei por não incluí-la no arquivo que mandei anteriormente. Mas segue um print do sistema afim de sanar as duvidas quanto a isso.



Abraço.

Olá, obrigado pelo retorno.
Relativamente ao restante código de filtro.
Parece estar bem.

Se pretende alternativa (será testar), eu pessoalmente sou muito adepto do exemplo do nosso colega Avelino Sampaio.
Veja abaixo no link abaixo, em especial Filtrar listbox à medida que se digita, faz parte do exemplo Maestro
usandoaccess.com.br/tutoriais/aprenda-filtragens-no-access.asp
Copiar e colar no browser
Abraço

Boa tarde,

Acredito que com a montagem da instrução, incluindo a consulta SQL esteja tudo bem, o problema mesmo é que não posso colocar todos os registros da tblCadastroChapas numa consulta por exemplo porque cada cavalete tem 8 chapas em média e no fomulário folha de dados seriam gerados 8 registro para cada cavelete, todos repetidos com o mesmo dado. Porém nesse caso o filtro funcionaria extremamente rapido. Aí está meu problema, quando pesquiso direto na tblCadastroChapas toda a instrução demora bastante pra ser concluída, porém quando monto uma consulta para dar origem ao subCavalete com todos os campos que envolvem a estrutura SQL o filtro funciona extremamente rapido. Meu impasse continua.

Abraço.

Amigo, Tem algo muito errado com seu App... Veja aqui um exemplo que fiz de pesquisa:

Conexão em 5 Bancos de dados diferentes;
Dados Unidos através de consulta União (5 Consultas de tabelas e bancos diferentes);
Apliquei o Filtro simultâneo do Maestro que Filtrar a medida que se digita;
Todos os 5 BD estão em um servidor da rede;
Totalizando 53mil registros;

Mesmo com toda essa carga de dados, vindo da rede, buscando em qualquer parte do campo a medida que se digita... Mesmo assim ainda está mais rápido do que a sua pesquisa!

Boa tarde,

Como você montou as consultas?

Uma coisa que me ocorreu: será que o problema pode estar no tráfego de rede?

Abraço.

Nao e problema na rede, pois aqui na minha maquina tabem ta lento... Tipo uns 2s pra retorno de um registro por exemplo.

No meu caso so fim uma consulta Unindo as 5 consultas... Dados pessoais basicos.


Executando seu codigo com interrupção, percebi que a demora ocorre pois a cada pesquisa, ele percorre os registros e edita um campo...
Nessa parte:

      If rs.RecordCount > 0 Then
              Do While Not rs.EOF
                  If Not rs!cavalete = "" Then
                     Set rsConsulta = db.OpenRecordset("select * from tblCavalete WHERE cavalete = " & rs!cavalete & "")
                       
                       If rsConsulta.RecordCount > 0 Then
                          rsConsulta.Edit
                               rsConsulta("selconsulta") = True
                           rsConsulta.Update
                       End If
                   End If
                   
                   rs.MoveNext
               Loop


Existe mesmo a necessidade de percorrer esses registros toda vez que chamar a função???

Remova essa parte, e edite o final do filtro onde busca selconsula=True (        filtro = filtro '& " and selconsulta = true"  ) e verá que funcionará feito foguete!

Bom dia,

O campo selconsulta serve pra eu marcar os registros que irão aparecer segundo os critérios que eu selecionei no filtro. Então em um momento esse campo será verdadeiro, mas em outro será falso.

Usando a pesquisa para campos que existam no subCavaletes, funciona perfeitamente, como um foguete de fato. Mas, quando usado com campos que não estejam no subformulário, não funciona. Teste usar o filtro com o campo "bloco". Um exemplo no print abaixo, filtrando pela "qualidade" do material (esse dado está na tblCadastroChapas), vê-se no resumo das chapas no rodapé que o cavalete selecionado é do tipo "Standard" e não "First" como eu havia selecionado.



Abraço.

Boa tarde,

Voltando para informar que consegui achar uma solução viável. Inseri na tabela uma campo filtroconsulta que concateno todos os campos de filtro que preciso que estão na tblCadastroChapa. Esse campo é preenchido no momento do cadastro dos cavaletes. Como um mesmo cavalete pode ter chapas de mais de um bloco, por exemplo, usei o ; como delimitador de cada filtro e , como delimitador interno da seção do filtro.

Depois só substitui os trechos correspondentes utilizando o operador like. O filtro ficou da seguinte maneira já rearranjado:

Código:

Public Function filtraRegistros()
    Dim sitTitulos      As Boolean
    Dim selEmpresa      As String
    Dim dataInicial, dataFinal, dataHoje
    Dim strConsulta As String
    Dim rs, rs1 As Recordset
    
    Call limpaPesquisaMaterial
    Call limpaTemporario
        
    cbxRelacaoChapas.Requery
    
    If selTodasEmpresas = True Then
        selEmpresa = False
    Else
        selEmpresa = getEmpresaAtual
    End If
        
    If Me.qdSitTitulos = 1 Then
        filtro = "baixado = false"
        setSitTitulo ("emAberto")
    Else
        filtro = "baixado = true"
        setSitTitulo ("baixado")
    End If

    strConsulta = "ativo = true"
    
    If Not IsNull(txtBloco) = True Then
        strConsulta = strConsulta & " and filtroconsulta like '*" & txtBloco & "*'"
    End If
        
    If cbxQualidade <> "*" Then
        strConsulta = strConsulta & " and filtroconsulta like '*" & cbxQualidade.Column(1) & "*'"
    End If
        
    If Not IsNull(txtDefeito) = True Then
        strConsulta = strConsulta & " and filtroconsulta like '*" & txtDefeito & "*'"
    End If
        
    If Not IsNull(txtEspessura) = True Then
        strConsulta = strConsulta & " and right(filtroconsulta, 1) like '*" & txtEspessura & "*'"
    End If
    
    If cbxPackingList <> "*" Then
        strConsulta = strConsulta & " and packinglist = '" & cbxPackingList.Column(0) & "'"
    End If
        
    If selAvulso = True Then
        strConsulta = strConsulta & " and packinglist = ''"
    End If
    
    filtro = strConsulta
  
    If DCount("marcado", "tblCadastroMaterial", "marcado = true") > 0 Then
        Dim strFiltroMaterial As String
            
        Set rsMM = db.OpenRecordset("SELECT codigo, marcado from tblCadastroMaterial where marcado = true")
            
        strFiltroMaterial = "codigomaterialcavalete = " & rsMM!codigo
        rsMM.MoveNext
            
        Do While Not rsMM.EOF
            strFiltroMaterial = strFiltroMaterial & "or codigomaterialcavalete = " & rsMM!codigo
            rsMM.MoveNext
        Loop
        
        filtro = filtro & " and " & strFiltroMaterial
    End If
            
    If Not IsNull(txtCavalete) = True Then
        filtro = filtro & " and cavalete = " & txtCavalete & ""
    End If
          
        Select Case qdReserva
            Case 1
                filtro = filtro & " and reservado = true"
            Case 2
                filtro = filtro & " and reservado = false"
        End Select
                
        If cbxClienteReserva <> "*" Then
            filtro = filtro & " and codigoclientereserva = " & cbxClienteReserva.Column(2) & ""
        End If
        
        dataInicial = Format(txtDataInicial, "mm/dd/yyyy")
        dataFinal = Format(txtDataFinal, "mm/dd/yyyy")
        dataHoje = Format(getDataHoje, "mm/dd/yyyy")
        
        Select Case Me.qdOptFiltro
            Case 1 'lançamento
                filtro = filtro & " and datalancamento Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
                
                
                subCavalete.Form.Filter = filtro
                subCavalete.Form.FilterOn = True
                subCavalete.Requery
            Case 2 'baixa
                filtro = filtro & " and baixadoem Between #" & dataInicial & "# AND #" & dataFinal & "# and ativo = true"
                
                
                subCavalete.Form.Filter = filtro
                subCavalete.Form.FilterOn = True
                subCavalete.Requery
            Case 3 'todos
                filtro = filtro & " and ativo = true"
                
                subCavalete.Form.Filter = filtro
                subCavalete.Form.FilterOn = True
                subCavalete.Requery
        End Select
End Function

Obrigado a todos que se dispuseram a me ajudar.

Abraço.

Olá Cassio,
Obrigado pelo retorno.
Foi a forma mais correcta e simples uma vez que pretende a marcação da selecção.

Abraço a todos