最小化VBA访问功能的执行时间 [英] Minimize execution time of an VBA-Access function

问题描述

我在Access中的AutoExec宏上运行以下函数。

I am running the following function on a AutoExec macro in Access.

问题是运行它大约需要40秒

The issue is that it takes approximately 40 sec (!!!) to run it which is way too long for roughly 200 records.

任何人都可以提出任何方法来最小化这个运行时间。

Can anyone suggest any way to minimize this runtime ?

的代码基本上是检查 RefreshedDatas表中的每个记录，如果其中一个多个值PartNo字段中的值存在于其他表的两个可能字段中（请参阅结构在图片：我必须检查是否SparPartNo字段SerialPartNo字段包含该值）。如果是，我将在 WPRC Part 字段中输入YES，否则输入NO。

The GOAL of this code is basically to check for each record in the RefreshedDatas table if one of the values in the multiple values' PartNo field exists in 2 possible fields from other table (see structure in picture : I have to check if either SparPartNo field either SerialPartNo field contain the value). If it is, I would write YES in a WPRC Part field, otherwise NO.

例如，

我检查并意识到代码的第5部分是39秒，前4个大约需要1秒。

I checked and realized that the part 5) of the code is the one taking 39 secs while the first 4 parts take about 1 sec.

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

推荐答案

这个代码的目标基本上是检查
RefreshedDatas表中的每个记录，如果一个在多个值中的值
PartNo字段存在于来自其他表的2个可能的字段中（参见
结构的图片：我必须检查SparPartNo字段
是否包含SerialPartNo字段）。如果是，我将在WPRC部分字段中写入
YES，否则为$。

The GOAL of this code is basically to check for each record in the RefreshedDatas table if one of the values in the multiple values' PartNo field exists in 2 possible fields from other table (see structure in picture : I have to check if either SparPartNo field either SerialPartNo field contain the value). If it is, I would write YES in a WPRC Part field, otherwise NO.

，你需要这个..

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

现在测试这个sql，它将列出所有零件，如果在partno集合中找到任何零件。 PartNo.Value是访问多个值字段中的项目的方式。

now test this sql, which will list all parts and if any parts found in the partno collection. PartNo.Value is the way to access items in a multiple value field.

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);

备份您的表格，并尝试此更新。类似于连接表，您还可以使用子查询从另一个表或同一个表中选择和查找值。

Backup your tables and try this update. Similar to join the tables, you can also use a sub query to select and find the values from another table or same table.

UPDATE RefreshedDatas
SET WPRC = "YES"
WHERE 
//if SparePartNo is available in the PartNo collection
    RefreshedDatas.SparePartNo in (SELECT P.PartNo.Value from RefreshedDatas as P WHERE P.ID = RefreshedDatas.ID)
// or if the SerialPartNo is available in the partNo Collection.
OR RefreshedDatas.SerialPartNo (SELECT S.PartNo.Value from RefreshedDatas as S WHERE S.ID = RefreshedDatas.ID)

没有办法测试代码，但你应该得到一些想法如何在SQL中工作。
如果要在整个PartNo集合中搜索零件号而不是在同一行中搜索零件号，请删除P WHERE P.ID = RefreshedDatas.ID。

have no means to test the code but you should get some idea how this works in SQL. Remove the "P WHERE P.ID = RefreshedDatas.ID" if you want to search for a part number in entire PartNo collection and not in the same row

这篇关于最小化VBA访问功能的执行时间的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！