.find vba работает медленно

В основном мне нужно пройти через 1,566 строк и сделать .find для каждой строки и сравнить с 10 691 строкой. Дело в том, что я объединяю три значения вместе, чтобы получить значение моего поиска. Он работает очень медленно, поэтому я попытался фильтровать по первому значению на 10 691, чтобы он работал быстрее, но без радости! Я использую несколько функций, письмо получает букву столбца.

Option Explicit Sub validate() Dim gbe As Worksheet, mp As Worksheet, PnS As Worksheet Dim rng As Range, Frng As Range Dim ITC, TT, BC, y, GCell, sz, t, vList t = Timer OptimizeVBA True ShDel ("Garbage"): Sheets.Add.name = "Garbage": Set gbe = Sheets("Garbage"): Set mp = Sheets("Master"): Set PnS = Sheets("PS") ITC = Letter(PnS, "Code"): TT = Letter(PnS, "Type"): BC = Letter(PnS, "BCode") mp.Range("M2:O" & mp.Range("A1").SpecialCells(xlCellTypeLastCell).Row).ClearContents PnS.Range((ITC & ":" & ITC & "," & TT & ":" & TT & "," & BC & ":" & BC)).Copy Destination:=gbe.Range("A1") gbe.Range("$A$1:$C$" & PnS.Range("A1").SpecialCells(xlCellTypeLastCell).Row).RemoveDuplicates Columns:=Array(1, 2, 3), _ Header:=xlYes gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter Field:=1, Criteria1:="='", _ Operator:=xlOr, Criteria2:="='FC" gbe.rows("2:" & gbe.Range("A1").End(xlDown).Row).EntireRow.Delete gbe.Range("A1:C" & gbe.Range("A1").End(xlDown).Row).AutoFilter Set rng = gbe.Range("A2:A" & gbe.Range("A1").SpecialCells(xlCellTypeLastCell).Row) For Each y In rng mp.Range("A1:K" & gbe.Range("A1").End(xlDown).Row).AutoFilter Field:=3, Criteria1:="=" & y With mp.Range("A2:A" & mp.Range("A1").SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible) Set GCell = .Find(What:=sz, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=True) If GCell Is Nothing Then mp.Range("O100000").End(xlUp) = PnS.Range(ITC & y.Row) mp.Range("O100000").End(xlUp).Offset(0, 1) = PnS.Range(TT & y.Row) mp.Range("O100000").End(xlUp).Offset(0, 2) = PnS.Range(BC & y.Row) End If Set GCell = Nothing mp.ShowAllData End With Next y ShDel ("Garbage") OptimizeVBA False MsgBox Timer - t End Sub 

Обычным предложением для выполнения операций над листами Excel является деактивация определенных настроек программным образом при выполнении кода.

Вот небольшой фрагмент, который я использую во многих своих проектах:

 Public Sub ExcelDefaultSettings(ByVal isActive As Boolean) With Application .ScreenUpdating = isActive .DisplayAlerts = isActive If isActive Then .Calculation = xlCalculationAutomatic Else .Calculation = xlCalculationManual End If End With End Sub 

И тогда вы просто сделаете эти два звонка до и после вашего исполнения:

 ExcelDefaultSettings isActive:=False 'Before ExcelDefaultSettings isActive:=True 'After 

Это не идеальное решение, но оно может очень помочь в крупных проектах.

Как сказал @Kyle и @Ralph, рефакторинг вашего кода также может помочь в улучшении вашей скорости выполнения.

Другим общим советом является: 1) перенести содержимое вашего диапазона в массив, 2) выполнить операции только по массиву, а затем 3) перенести массив обратно в ваш диапазон.

Это немного больше, чем добавление кода, но здесь можно найти довольно хорошее объяснение.

Это пример, который они дают для базового цикла:

 Dim Arr() As Variant Arr = Range("A1:B10") Dim R As Long Dim C As Long For R = 1 To UBound(Arr, 1) ' First array dimension is rows. For C = 1 To UBound(Arr, 2) ' Second array dimension is columns. Debug.Print Arr(R, C) Next C Next R 
Давайте будем гением компьютера.