有没有一种方法可以改善执行时间?

时间:2020-02-17 13:53:50

标签: excel database vba ms-access findfirst

我正在开发一个VBA代码,该代码负责在excel文件中搜索单元格(序列号)的值及其生产开始日期。之后,它在Access数据库中搜索相同的序列号,并将日期写在指定的列上。 问题是要花费数小时才能结束,因为excel和数据库有超过10000行... 问题是:有一种方法可以改善代码以使其运行得更快?

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

1 个答案:

答案 0 :(得分:0)

1)请勿将db.FindNextdb.FindPrevious用于相同的搜索标准。这对您的情况没有意义。

仅使用FindFirst,并摆脱db.MoveNext

    db.FindFirst "[NUMERO_SERIE] = '" + Numero_serie + " '"
    If db.NoMatch Then
        Fileout.Write Numero_serie & "  "
    Else
        db.Edit
        db![INICIO_FBR] = Inicio_planejado
        db.Update
        ' Remove this, is is of no use:
        '--- db.MoveNext
    End If

2)在Access中,编辑表ConsultaNSerie并在NUMERO_SERIE上添加索引