Ausführungszeit einer VBA-Access-Funktion minimieren

Question

Ich führe die folgende Funktion für ein AutoExec-Makro in Access aus.

Das Problem ist, dass es dauert ca. 40 Sekunden (!!!), um es zu laufen, die viel zu lang für etwa 200 Datensätze ist.

Kann jemand vorschlagen, diese Laufzeit zu minimieren?

Das Ziel dieses Codes ist grundsätzlich für jeden Datensatz in den RefreshedDatas table zu überprüfen, ob einer der Werte in den PartNo Feld mehr Werte existiert in zwei möglichen Feldern aus anderen table (Struktur im Bild sehen: Ich habe zu prüfen, ob entweder das Feld SparPartNo oder das Feld SerialPartNo den Wert). Wenn ja, würde ich JA in ein WPRC Part Feld schreiben, sonst NEIN.

So als Beispiel

I geprüft und festgestellt, dass der Teil 5) des Codes der eine 39 Sekunden, während die ersten vier Teile dauern etwa 1 Sekunde nehmen ist.

Function PopulationOfWPRCField() 

'1) Create an access to the PartNo field (=Recordset) and store all its values in an array called arrayPartNo 
    Dim conn As New ADODB.Connection 
    Dim connStr As String 
    Dim rs As ADODB.Recordset 
    Dim PartNoSQL As String 
    Dim arrayPartNo() As Variant 

    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "PathtoMyAccessDatabase\" & "NewVersion.accdb" & ";" 
    conn.ConnectionString = connStr 
    conn.Open 
    Set rs = New ADODB.Recordset 
    PartNoSQL = "SELECT PartNo FROM RefreshedDatas" '"SELECT PartNo FROM 12Dec" 
    rs.Open PartNoSQL, conn, adOpenStatic, adLockReadOnly, adCmdText 

    If Not rs.EOF Then 
     arrayPartNo = rs.GetRows 
    End If 
    'Set rs = Nothing 


'2) Same with fields SerialPartNo and SparePartNo from the WPRC_List (+ShipmentID for the 4th part of this code) 
    Dim arraySerialPartNo() As Variant 
    Dim arraySparePartNo() As Variant 
    Dim arrayShipmentID() As Variant 
    Dim SerialPartNoSQL As String 
    Dim SparePartNoSQL As String 
    Dim ShipmentIDSQL As String 

    'For SpartNo 

     Set rs = New ADODB.Recordset 
     SparePartNoSQL = "SELECT SparePartNo FROM WPRC_Parts_List" 
     rs.Open SparePartNoSQL, conn, adOpenStatic, adLockReadOnly, adCmdText 
     If Not rs.EOF Then 
      arraySparePartNo = rs.GetRows 
     End If 
     'For i = 0 To UBound(arraySparePartNo, 2) 
     ' Debug.Print arraySparePartNo(0, i) 
     'Next i 
     Set rs = Nothing 

    'For SerialNo 

     Set rs = New ADODB.Recordset 
     SerialPartNoSQL = "SELECT SerialPartNo FROM WPRC_Parts_List" 
     rs.Open SerialPartNoSQL, conn, adOpenStatic, adLockReadOnly, adCmdText 
     If Not rs.EOF Then 
      arraySerialPartNo = rs.GetRows 
     End If 
     'For i = 0 To UBound(arraySerialPartNo, 2) 
     ' Debug.Print arraySerialPartNo(0, i) 
     'Next i 
     Set rs = Nothing 

    'For ShipmentID 

    Set rs = New ADODB.Recordset 
     ShipmentIDSQL = "SELECT [Shipment ID] FROM RefreshedDatas" 
     rs.Open ShipmentIDSQL, conn, adOpenStatic, adLockReadOnly, adCmdText 
     If Not rs.EOF Then 
      arrayShipmentID = rs.GetRows 
     End If 
     'For i = 0 To UBound(arrayShipmentID, 2) 
     ' Debug.Print arrayShipmentID(0, i) 
     'Next i 
     Set rs = Nothing 

     Set conn = Nothing 

'3) We calculate the size of the GoodArray() we'll declare later on so that we can declare it properly 
    Dim h As Integer 
    Dim longest As Integer 
    longest = 0 
    For h = 0 To UBound(arrayPartNo, 2) ' in this loop we search for the longest character in arrayPartNo and store its size in "longest" 
     If Len(arrayPartNo(0, h)) > longest Then longest = Len(arrayPartNo(0, h)) 
    Next h 
    'MsgBox longest '63 in this case 
    h = (longest + 1)/8 ' since h was only used in the loop above we reuse it to store this = 8 -> size of the 2nd dimension of GoodArray() , it represents the biggest number of PartNo a cell in arrayPartNo contains 
    longest = UBound(arrayPartNo, 2) ' same here, we just reuse the variable to store this -> size of the 1st dimension of GoodArray() , it represents the number of cells(=records) in arrayPartNo (in the MainForm) 



'4) Declaration of the 2-dimensional array GoodArray() and population of it 
    Dim NumberOfPartNo As Integer ' Number of PartNo in a specific row 
    Dim length As Integer ' length of a correct PartNo 
    Dim i As Integer 
    Dim GoodArray() As Variant ' this is a 2 dimensional array where 1st dimension contains UBound(arrayPartNo, 2) cells and 2nd dimension contains the number of PartNo (=NumberOfPartNo) for the row determined by the 1st dimension) 
    ' reason for (longest+1)/8 : we have the following equation : x*7 + (x-1)= longest where x is the number of PartNo(but for the record which has the most PartNo) and (x-1) is the number of ";" separating all those PartNo, the total gives the number of character of the record (= longest for the record with the most PartNo) 
    ReDim Preserve GoodArray(longest, h) 
For i = 0 To UBound(arrayPartNo, 2) 

    length = 7 
    NumberOfPartNo = 0 
    If Len(arrayPartNo(0, i)) > 0 Then 
      Do 
       GoodArray(i, NumberOfPartNo) = Mid(arrayPartNo(0, i), length + 1 - 7, 7) 
       NumberOfPartNo = NumberOfPartNo + 1 
       length = length + 8 

      Loop While Len(arrayPartNo(0, i)) >= length ' since we use such a loop it allows any PartNo to go through it even if it has less than 6 characters 
     End If 
Next i 

'5) Comparison of the arrays : For each element contained in GoodArray() check if it is included in arraySerialPartNo or arraySparePartNo 
Dim j As Integer 
Dim k As Integer 
'Dim OnList As Boolean 
For i = 0 To UBound(GoodArray, 1) 
    k = 0 
    'OnList = False 
    Do Until GoodArray(i, k) = "" 
     For j = 0 To UBound(arraySerialPartNo, 2) 
      If arraySerialPartNo(0, j) = GoodArray(i, k) Then 
       DoCmd.RunSQL "UPDATE RefreshedDatas Set [WPRC Part] = 'Yes' WHERE [Shipment ID] = " & arrayShipmentID(0, i) 
       'OnList = True 
       GoTo Prochain 
      End If 
     Next j 

     For j = 0 To UBound(arraySparePartNo, 2) 
      If arraySparePartNo(0, j) = GoodArray(i, k) Then 
       DoCmd.RunSQL "UPDATE RefreshedDatas Set [WPRC Part] = 'Yes' WHERE [Shipment ID] = " & arrayShipmentID(0, i)     
       'OnList = True 
       GoTo Prochain 
      End If 
     Next j 

     k = k + 1 
    Loop 

    DoCmd.RunSQL "UPDATE RefreshedDatas Set [WPRC Part] = 'No' WHERE [Shipment ID] = " & arrayShipmentID(0, i)   
Prochain: 

Next i 

End Function 

Answer 1

Das Ziel dieses Codes im Grunde für jeden Datensatz in der RefreshedDatas Tabelle zu überprüfen ist, wenn einer der Werte in der mehrere Werte ' PartNo Feld existiert in 2 möglichen Feldern aus anderen Tabelle (siehe Struktur in Bild: Ich muss überprüfen, ob entweder SparPartNo Feld entweder SerialPartNo Feld den Wert enthalten). Wenn ja, würde ich JA in ein WPRC-Teilfeld schreiben, sonst NEIN.

Soweit ich verstehen kann, müssen Sie dies ..

UPDATE RefreshedDatas 
SET WPRC = "NO"; // Everything is set to no. 

jetzt diese SQL-Test, der alle Teilliste wird und, wenn Teile in der teilenr Sammlung gefunden. PartNo.Value ist die Möglichkeit, auf Elemente in einem Feld mit mehreren Werten zuzugreifen.

Select 
R.SparePartNo 
R.SerialPartNo 
iif(isnull(R2.PartNo.value),"No", "Yes") as [Part found] 
FROM RefreshedDatas as R left join RefreshedDatas as R2 
    ON (R.SparePArtNo = R2.PartNo.Value OR R.SerialPartNo = R2.PArtNo.Value); 

Sichern Sie Ihre Tabellen und versuchen Sie dieses Update. Ähnlich wie bei den Tabellen können Sie auch eine Unterabfrage verwenden, um die Werte aus einer anderen Tabelle oder derselben Tabelle auszuwählen und zu suchen.

haben keine Mittel, um den Code zu testen, aber Sie sollten eine Idee bekommen, wie dies in SQL funktioniert. Entfernen Sie die "P WHERE P.ID = RefreshedDatas.ID", wenn Sie nach einer Teilenummer in der gesamten PartNo Sammlung und nicht in der gleichen Zeile suchen möchten

Answer 2

Nein wirklich eine Antwort, aber ...

IF Ihre 2 Tabellen richtige Primärschlüssel haben, und
IF Sie eine richtige Beziehung definieren (mit referentielle Integrität) zwischen Die 2 Tabellen

DANN Sie müssen nicht einmal überprüfen, ob es eine Übereinstimmung gibt, und Sie können nur löschen Code.

Und trotzdem könnte dieser Code mit nur Update-Abfragen getan werden, wenn ich es gut verstanden habe. Ich sehe keinen Grund, mit Arrays zu spielen.

Ich würde sogar denken, dass Sie keine Update-Abfrage benötigen. Verwenden Sie einfach ein SELECT Abfrage mit einer LEFT JOIN einer Formel einschließlich Angabe „Match“ oder „No match“