Увеличение скорости оператора For L oop & With в VBA - PullRequest
0 голосов
/ 13 июля 2020

У меня есть код (написанный ниже), который работает и выполняет именно то, что мне нужно, но я хотел бы улучшить время его выполнения, так как иногда требуется несколько секунд для того, что, как я считаю, должно занимать долю секунды ( при правильной настройке).

В основном я использую VBA для создания формулы индекса и сопоставления с другой книгой, из которой он извлекает информацию (параметры). У меня есть комментарии, добавленные к каждой строке для дальнейшего объяснения моего кода (прокрутите вправо), но я считаю, что медленное время обработки как-то связано с использованием моего With statement для каждой отдельной ячейки внутри For loop. Я просто хочу найти решение для увеличения скорости моего кода, поскольку иногда это занимает слишком много времени для моего приложения.

Пожалуйста, дайте мне знать, если у вас есть какие-либо вопросы или предложения!

'This macro uses an Index and Match application to fill in the "Changes Pending Approval" parameters in the "Operator" worksheet

Private Sub Worksheet_Calculate()                                                                   'Occurs after the worksheet is recalculated for the Worksheet object (any changes in the intersect cell)

Application.ScreenUpdating = False                                                                  'This speeds up the macro by hiding what the macro is doing

If Not Intersect(Range("H4"), Range("H4")) Is Nothing Then                                          'Checking if the "Key" (part or process) has been changed

Dim yChanges As Worksheet, OperatorWs As Worksheet                                                  'Declaring worksheets as variables
Dim yChangesLastRow As Long, Parameters As Long, x As Long, z As Long                               'Declaring variables to count last rows and "x" & "z" as integers (long variables)

Set y = Workbooks.Open(Filename:="\Databases\Database_IRR 200-2S.xlsm", Password:="123")            'Sets the Workbook variable as the database filepath
Set yChanges = y.Sheets("Changes")                                                                  'Sets the Worksheet variable as the "Changes" sheet in the database's workbook
Set OperatorWs = ThisWorkbook.Worksheets("Operator")                                                'Sets the Worksheet variable as the "Operator" sheet in this workbook
OperatorWs.Unprotect "123"                                                                          'Unprotects the "Operator" sheet

Parameters = yChanges.Range("F1:CL1").Columns.Count                                                 'Counts the number of columns in the "Changes" sheet

yChangesLastRow = yChanges.Range("A" & Rows.Count).End(xlUp).Row                                    'Finds the last row in the "Changes" sheet & counts the number of rows

yChangesLastRow = yChangesLastRow - 2                                                               '-2 from the number of rows to account for the header & Vlookup (2nd) column

z = 6                                                                                               'Sets variable "z" to start with the first parameter in the "Changes" sheet (Column "F")

    For x = 31 To Parameters + 31                                                                   'Sets variable "x" to start from the first Parameter in the "Operator" sheet to the last row
                                                                                                        
        With yChanges                                                                               'With the "Changes" sheet do the following

            Dim IndexRng As Range                                                                   'Declaring variable as a range
            Set IndexRng = .Range(.Cells(3, z), .Cells(yChangesLastRow, z))                         'Sets range variable as the index lookup array (Pending Changes entries)

            Dim MatchRng As Range                                                                   'Declaring variable as a range
            Set MatchRng = .Range("A3:A" & yChangesLastRow)                                         'Sets range variable as the match lookup array (Pending changes "Keys" only)

        End With                                                                                    'Ending the "With statement"

    Dim matchNum As Variant                                                                         'Declaring variable as general datatype
    matchNum = Application.Match(Sheet1.Range("H4").Value, MatchRng, 0)                             'Sets variable equal to the Match function to find the "Key" in the "Changes" sheet

                If Not IsError(matchNum) Then                                                       'Checking if the "Key" is in the "Changes" sheet (True or False)

                    OperatorWs.Range("N" & x).Value = Application.Index(IndexRng, matchNum)         'True: Sets the Changes Pending Approval parameters in the "Operator" sheet

                Else                                                                                'False: no match was found for the "Key" (Part & Process) in the "Changes sheet

                    Exit Sub                                                                        'End the macro

                End If                                                                              'End the "IF" statement
    
    z = z + 1                                                                                       '+1 to execute the "For" statement with the next (lookup) parameter

    Next x                                                                                          'Executes the "For" statement with the next "x" value (+1 until it reaches the "Parameters + 31" integer)

OperatorWs.Protect "123"                                                                            'Protect the "Operator" sheet
    
        y.Save                                                                                      'Save the database Workbook
    
        y.Close False                                                                               'Close the database Workbook

End If                                                                                              'End the "IF" statement

Application.ScreenUpdating = True                                                                   'Must be "True" after running the code to be able to Read/Write the Workbook

End Sub                                                                                             'End the macro
...