excel - 如何优化 VBA 代码以比较信息

Question

代码正在做我需要做的一切。尽管完成宏需要几分钟以上的时间，但花费的时间太长了。如何优化此 VBA 代码以更快地运行？

我是 VBA 新手，我不太确定如何进行。此代码将在大约 35,000 行数据上运行。

我有一种感觉是因为我的循环没有在数组上运行？

Public Sub matchRow()

    Dim dumpSheet, activeSheet, outputSheet As Worksheet
    Dim startRow, outputRow, tempDumpRow, tempActiveRow, activeRowCount, finishedActiveIndex As Integer
    Dim finishedActive() As String
    Dim isExist As Boolean

    Call OptimizeCode_Begin

    'Set sheets
    Set dumpSheet = Sheets("Dump")
    Set activeSheet = Sheets("Active Directory")
    Set outputSheet = Sheets("Output")

    'Set start row of each sheet for data
    startRow = 5
    outputRow = 5

    'Get row count from Active Depository sheet
    activeRowCount = activeSheet.Range("B5:D5").End(xlDown).Row

    'Set index
    finishedActiveIndex = 5

    'Re-define array
    ReDim finishedActive(5 To activeRowCount - 1)

    'Set the start row
    tempDumpRow = startRow

    'Here I looped with OR state, you can modify it to AND start if you want
    Do While dumpSheet.Range("B" & tempDumpRow) <> "" Or dumpSheet.Range("C" & tempDumpRow) <> "" Or dumpSheet.Range("D" & tempDumpRow) <> ""

        'Reset exist flag
        isExist = False

        'loop all row in Active Depository sheet
        For tempActiveRow = 5 To activeRowCount Step 1

            'If row is not finished for checking.
            If UBound(Filter(finishedActive, tempActiveRow)) < 0 Then

                'If all cell are equal
                If dumpSheet.Range("B" & tempDumpRow) = activeSheet.Range("B" & tempActiveRow) And _
                   dumpSheet.Range("C" & tempDumpRow) = activeSheet.Range("C" & tempActiveRow) And _
                   dumpSheet.Range("D" & tempDumpRow) = activeSheet.Range("D" & tempActiveRow) Then

                    'Set true to exist flag
                    isExist = True

                    'Store finished row
                    finishedActive(finishedActiveIndex) = tempActiveRow

                    finishedActiveIndex = finishedActiveIndex + 1

                    'exit looping
                    Exit For

                End If

            End If

        Next tempActiveRow

        'Show result
        outputSheet.Range("B" & outputRow) = dumpSheet.Range("B" & tempDumpRow)
        outputSheet.Range("C" & outputRow) = dumpSheet.Range("C" & tempDumpRow)
        outputSheet.Range("D" & outputRow) = dumpSheet.Range("D" & tempDumpRow)

        If isExist Then
            outputSheet.Range("E" & outputRow) = ""
        Else
            outputSheet.Range("E" & outputRow) = "Item found in ""Dump"" but not in ""Active Directory"""
        End If

        'increase output row
        outputRow = outputRow + 1

        'go next row
        tempDumpRow = tempDumpRow + 1

    Loop

    'loop all row in Active Depository sheet
    For tempActiveRow = 5 To activeRowCount Step 1

        'If row is not finished for checking.
        If UBound(Filter(finishedActive, tempActiveRow)) < 0 Then

            'Show result
            outputSheet.Range("B" & outputRow) = activeSheet.Range("B" & tempActiveRow)
            outputSheet.Range("C" & outputRow) = activeSheet.Range("C" & tempActiveRow)
            outputSheet.Range("D" & outputRow) = activeSheet.Range("D" & tempActiveRow)
            outputSheet.Range("E" & outputRow) = "Item found in ""Active Directory"" but not in ""Dump"""

            'increase output row
            outputRow = outputRow + 1

        End If

    Next tempActiveRow

    Call OptimizeCode_End

End Sub




Sub OptimizeCode_Begin()

    Application.ScreenUpdating = False

    EventState = Application.EnableEvents
    Application.EnableEvents = False

    CalcState = Application.Calculation
    Application.Calculation = xlCalculationManual

    PageBreakState = activeSheet.DisplayPageBreaks
    activeSheet.DisplayPageBreaks = False

End Sub

标签： excelvbaoptimizationcompare