How can I decrease the running time in my application in VBA

Asked

Viewed 137 times

2

Hello, I am developing an application in VBA that is responsible for searching in an excel spreadsheet 2 data in different columns: the serial number, and the beginning of manufacturing. Then, I relate to a table in Access and compare the serial number present in the database, and insert in the INICIO_FBR column, the beginning of manufacturing coming from excel. The problem is that there are thousands of data, and to go through the entire database table is taking a long time, when I use Findfirst, or even with a Findnext and then a Findprevious, as this in the code below. The question is whether there is another way to do this search and relationship in a faster way? If so, how? Thank you since!

Private Sub Comando9_Click()
 Set db = CurrentDb.OpenRecordset("ConsultaNSerie", dbOpenDynaset)
 Set appExcel = CreateObject("Excel.Application")
'appExcel.Visible = True
 appExcel.Application.Workbooks.Open "K:\EM HP - Comum\Planejamento de 
 Produção HP\CB\Planejamento de Produção_CB_FY19-20\Planejamento de 
 Produção_CB_FY19-20.xlsm"

 Dim Inicio_planejado As Variant
 Dim Numero_serie As String
 Dim SAP As String
 i = 9

 Dim fso As Object
 Set fso = CreateObject("Scripting.FileSystemObject")

 Dim Fileout As Object
 Set Fileout = fso.CreateTextFile("K:\EM HP - Engenharia\02-Aplicação\11- 
 Controle de Projetos\Nserie_NoMatch.txt", True, True)

 Do
     SAP = appExcel.Sheets("Disjuntores").Columns("I").Rows(i).Value
     Numero_serie = appExcel.Sheets("Disjuntores").Columns("L").Rows(i).Value
     'MsgBox (Numero_serie)
     Inicio_planejado = 
     appExcel.Sheets("Disjuntores").Columns("T").Rows(i).Value

    If Inicio_planejado <> "" Then
        'MsgBox (Inicio_planejado)
        'quando for vazio, desconsiderar a celula
        'ThisWorkbook.Reg.FindFirst "[OF] = '" + cb_OF.Value + " '"
        db.FindNext "[NUMERO_SERIE] = '" + Numero_serie + " '"
        If db.NoMatch Then
            db.FindPrevious "[NUMERO_SERIE] = '" + Numero_serie + " '"
        ElseIf db.NoMatch Then
            Fileout.Write Numero_serie & "  "
            'MsgBox ("Número de série " + Numero_serie + " não encontrado")
        Else
             'Adicionar o valor de "Inicio_planejado" aos campos na coluna 
      "INICIO_FBR"
             db.Edit
             db![INICIO_FBR] = Inicio_planejado
             db.Update
             db.MoveNext
        End If
 End If

 i = i + 1

 Loop Until appExcel.Sheets("Disjuntores").cells(i, 7) = ""

 Fileout.Close
 appExcel.Quit

 End Sub
excel vba ms-access

  • A loop in each row can be time consuming, there is other ways to locate. Each with a different performance. The fastest is the use of Arrays (Variant Array, Scripting.Dictionary or Collection), because it decreases the interaction between the VBA and the Excel spreadsheet, therefore, it is the most recommended for large tables. See a performance analysis

1 answer

0

André is right, there are several ways to get the same result each with different performance, you will have to test some until you get the best performance possible or satisfactory.

My suggestion is : 1-) Import Excel data into a temporary table, tmpProduction for example. 2-) Make a single query with UPDATE in the Consultanserie table to change the INICIO_FBR field 3-) Perform another query with a simple SELECT from the tmpProduction table related to the Consultanserie table to display serial numbers that do not exist

All the times I needed to do something similar, I did it this way and I always got a good performance.

Hug

Browser other questions tagged excel vba ms-access

You are not signed in. Login or sign up in order to post.