locked
Acessar Banco mais Rapidamente RRS feed

  • Pergunta

  • Boa Tarde possuo uma planilha do excel (=Buscar.BuscaChassi ) que acessa meu banco e busca informação do Chassi de veiculos, na planilha excel coloco o chassi e se tiver igual no banco me retorna toda a informação do veiculo, mas como é um volume muito grande de informação demora demais para a verificação, gostaria de saber  se tem um modo em que seja mais rapido a busca.



    Segue o codigo se tiver alguem pra ajudar



    Function BuscaChassi(Banco As String, Chassi As String, Retorno As String) As String
        Dim Conexao As ADODB.Connection 'Variável que fará a conexão com o banco
        Dim RS As ADODB.Recordset 'Variável que retornará o resultado
        Dim SQL As String 'Variável que vai armazenar a instrução SQL
        Dim Resultado As String 'Resultado da função
        
        'Define a conexão com o banco de dados
        Set Conexao = New ADODB.Connection
        Conexao.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Banco
        Conexao.Open

        'Monta a instrução SQL
        Set RS = New ADODB.Recordset
        SQL = "SELECT " & Retorno & " FROM [Tabela de Frota] WHERE [CHA_NUMERO] = '" & Chassi & "'"
        RS.Open SQL, Conexao

        'Descobre se achou ou não
        If Not (RS.EOF) Then
            If IsNull(RS.Fields(0).Value) Then
                Resultado = ""
            Else
                Resultado = RS.Fields(0).Value
            End If
        Else
            Resultado = "NÃO ENCONTRADO"
        End If
            
        'Retorna o resultado de achou para a função
        BuscaChassi = Resultado
    End Function


    Grato.
    terça-feira, 1 de fevereiro de 2011 16:27

Respostas

  • Sub pega_BuscaChassi() 
        dim banco as string  'variável que contém o nome do banco 
        Dim Conexao As ADODB.Connection 'Variável que fará a conexão com o banco
        Dim RS As ADODB.Recordset 'Variável que retornará o resultado
        Dim SQL As String 'Variável que vai armazenar a instrução SQL
        dim onde_por as range ' local onde os dados serão copiados 
        dim campos as string ' lista de campos na ordem em que ficarão na coluna
        dim quais_chassis as string 
        dim faixa_chassis as range ' faixa que conterá os chassis a serem buscados

         set banco = "banco tal"  ' coloque aqui o nome do banco de dados 

        set onde_por = range( "B10:F1000" )  '  coloque aqui a faixa onde os dados serão colocados
    ' deve ser grande suficiente para caber tudo, ou ele vai truncar.

        
    set faixa_chassis = range( "A10:A10000" )  ' coloque aqui a faixa que contém os 
    ' chassis a serem buscados

        quais_chassis = " ( 'XXXXX'   "   

         for each um_chassis in faixa_chassis 
              quais_chassis = quais_chassis & " , '" & um_chassis.value & "'" 
         next
         quais_chassis = quais_chassis & ")"

    ' coloque na variável campos, na ordem desejada, os campos do banco de dados 

        campos = " renavam, cor, modelo, tipo, fabricante, data_de_emissao "  
        
        'Define a conexão com o banco de dados
        Set Conexao = New ADODB.Connection
        Conexao.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Banco
        Conexao.Open

        'Monta a instrução SQL
        Set RS = New ADODB.Recordset
        SQL = "SELECT " & campos  & " FROM [Tabela de Frota] WHERE [CHA_NUMERO] in " & quais_Chassis 
        RS.Open SQL, Conexao

        'Descobre se achou ou não
        If RS.recordcount  = 0  Then
            msgbox( " Acredita que num achou sequer 1 chassis ?!!!! " ) 
            exit sub
        endif
        onde_por.cells.copyfromrecordset rs

    End sub

    experimente

    João Eurico Consultor Manguetown - Brazil
    • Marcado como Resposta langoBel segunda-feira, 21 de fevereiro de 2011 11:50
    quinta-feira, 3 de fevereiro de 2011 18:54

Todas as Respostas

  • Analisando a sua função ela tem nada de errado.

    Então qual é o problema ? O problema é de concepção da solução. Você está chamando a função a cada ítem e para cada ítem vc está chamando a função para cada CAMPO da tabela. Só que a cada chamada da função, a conexão com o banco é estabelecida. Isso é o que está causando a lentidão.

    Como resolver ? Redesenha completamente, em vez de usar uma função, fazer uma macro para submeter a query de uma vez só ao banco e trazer todos os dados de uma só vez. Isso vai ficar SUPER mais rápido.

    Outra forma é vc tentar estabelecer a conexão com o banco e salvá-la, fazer as queries usando a conexão pré-estabelecida (já poupa o tempo de estabelecer a conexão). Mesmo assim, vai fazer uma query para cada ítem x cada campo. Suponha que sejam 1000 ítems e 10 campos

    1000 ítens x 10 campos = 10 mil queries e 10 mil criações de conexão.

     

    A forma mais eficiente seria criar uma query só assim numa macro

     

    'select campo1, campo2, campo3, campo4 from  [Tabela de Frota] where  [CHA_NUMERO]  in ( ' &  string_com todos os chassis desejados ' )'

     

    Essa string com todos os chassis desejados seria a concatenação dos chassis desejados, entre aspas e separados por  , (vírgula)

     

    A macro montaria essa string ao varrer a faixa dos chassis desejados.

     

    Depois que o result set estivesse populado, aí era só dar um copy from result set para a faixa destino.

    A ordem dos campo1, campo2, campo3 é fundamental pois tem que ser a mesma que vc quer na sua planilha.

    QUe tal ? Que achou da idéia ? 



    João Eurico Consultor Manguetown - Brazil
    terça-feira, 1 de fevereiro de 2011 19:26
  • Bom dia !!!

    João sou iniciante e o maximo que consegui foi isso, tem alguma forma de vc me ajudar ???

     

    Grato.

    quarta-feira, 2 de fevereiro de 2011 09:53
  • Sim, vou tentar fazer a macro aqui e depois eu mando para vc. Talvez precise de ajustes na vida real.

     


    João Eurico Consultor Manguetown - Brazil
    quinta-feira, 3 de fevereiro de 2011 09:57
  • Sub pega_BuscaChassi() 
        dim banco as string  'variável que contém o nome do banco 
        Dim Conexao As ADODB.Connection 'Variável que fará a conexão com o banco
        Dim RS As ADODB.Recordset 'Variável que retornará o resultado
        Dim SQL As String 'Variável que vai armazenar a instrução SQL
        dim onde_por as range ' local onde os dados serão copiados 
        dim campos as string ' lista de campos na ordem em que ficarão na coluna
        dim quais_chassis as string 
        dim faixa_chassis as range ' faixa que conterá os chassis a serem buscados

         set banco = "banco tal"  ' coloque aqui o nome do banco de dados 

        set onde_por = range( "B10:F1000" )  '  coloque aqui a faixa onde os dados serão colocados
    ' deve ser grande suficiente para caber tudo, ou ele vai truncar.

        
    set faixa_chassis = range( "A10:A10000" )  ' coloque aqui a faixa que contém os 
    ' chassis a serem buscados

        quais_chassis = " ( 'XXXXX'   "   

         for each um_chassis in faixa_chassis 
              quais_chassis = quais_chassis & " , '" & um_chassis.value & "'" 
         next
         quais_chassis = quais_chassis & ")"

    ' coloque na variável campos, na ordem desejada, os campos do banco de dados 

        campos = " renavam, cor, modelo, tipo, fabricante, data_de_emissao "  
        
        'Define a conexão com o banco de dados
        Set Conexao = New ADODB.Connection
        Conexao.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + Banco
        Conexao.Open

        'Monta a instrução SQL
        Set RS = New ADODB.Recordset
        SQL = "SELECT " & campos  & " FROM [Tabela de Frota] WHERE [CHA_NUMERO] in " & quais_Chassis 
        RS.Open SQL, Conexao

        'Descobre se achou ou não
        If RS.recordcount  = 0  Then
            msgbox( " Acredita que num achou sequer 1 chassis ?!!!! " ) 
            exit sub
        endif
        onde_por.cells.copyfromrecordset rs

    End sub

    experimente

    João Eurico Consultor Manguetown - Brazil
    • Marcado como Resposta langoBel segunda-feira, 21 de fevereiro de 2011 11:50
    quinta-feira, 3 de fevereiro de 2011 18:54
  • Vou tentar fazer depois te aviso !!!!!!!

     

    Grato.

     

     

     


    Lango
    segunda-feira, 7 de fevereiro de 2011 10:35