Проблема: код выполняется примерно за 30 секунд на запись. Нужно оптимизировать скорость. Электронная таблица построена вокруг 1 страницы из 100 000 записей, одна запись сравнивается с 100 другими записями из списка с использованием расширенного фильтра и поиска. Вычисляются различные корректировки, а затем значения из расчета возвращаются обратно на «страницу вывода» примерно для 60 000 записей. Выпуск составляет 60 000 записей * 30 секунд = 500 часов. Спасибо.
Sub EquityAutomated()
Dim i As Long
Dim StartNo As Long
Dim EndNo As Long
StartNo = InputBox("Enter the row on the Hsheet sheet you want the equity analysis to start on")
EndNo = InputBox("Enter the row on the Hsheet sheet you want the equity analysis to end on")
Dim wsProtestTest As Worksheet: Set wsProtestTest = Worksheets("ProtestTestData")
Dim wsES As Worksheet: Set wsES = Worksheets("EquitySpreadsheet")
Dim wsEL As Worksheet: Set wsEL = Worksheets("EquityList")
Dim wsDa As Worksheet: Set wsDa = Worksheets("Res")
Dim subTotalsDa As Range: Set subTotalsDa = wsDa.Range("A10:A647649")
Dim fltrRng As Range: Set fltrRng = wsDa.Range("A9:T647649")
Dim fltrCritRng As Range: Set fltrCritRng = wsDa.Range("A1:T2")
Dim valRngDa As Range: Set valRngDa = wsDa.Range("T10:T647649")
Dim fullSrtRng As Range: Set fullSrtRng = wsDa.Range("A9:S647649")
Dim sortValRng As Range: Set sortValRng = wsDa.Range("T9")
Dim fullSortRngVal As Range: Set fullSortRngVal = wsDa.Range("A10:T647649")
Dim equityRankRng As Range: Set equityRankRng = wsEL.Range("P5")
Dim equityOutOfRng As Range: Set equityOutOfRng = wsEL.Range("P4")
Dim MedianRng As Range: Set MedianRng = wsEL.Range("O6")
Dim propValRng As Range: Set propValRng = wsEL.Range("D5")
Dim diffRng As Range: Set diffRng = wsEL.Range("O7")
Dim MinRng As Range: Set MinRng = wsEL.Range("O8")
Dim MaxRng As Range: Set MaxRng = wsEL.Range("O9")
Dim avgRng As Range: Set avgRng = wsEL.Range("O10")
Dim LogRng As Range: Set LogRng = wsES.Range("B10")
Dim Support3kLowerRng As Range: Set Support3kLowerRng = wsEL.Range("O11")
Application.ScreenUpdating = False
For i = StartNo To EndNo
LogRng = wsProtestTest.Cells(i + 2, 1).Value2
subTotalsDa.ClearContents
Application.Calculate
If Not Application.CalculationState = xlDone Then
DoEvents
End If
Application.Calculation = xlManual
fltrRng.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=fltrCritRng, Unique:=False
Application.Calculation = xlCalculationAutomatic
Application.Calculate
subTotalsDa.SpecialCells(xlCellTypeVisible).FormulaR1C1 = _
"=Subtotal(3,R10C2:RC[1])"
valRngDa.SpecialCells(xlCellTypeVisible).Formula = _
"=INDEX(EquitySpreadsheet!$C$12:$GT$29,16,(MATCH(INDIRECT(ADDRESS(ROW(),1)),EquitySpreadsheet!$C$12:$GS$12)+1))"
With wsDa.Sort
.SortFields.Clear
.SortFields.Add Key:=valRngDa, SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange fullSortRngVal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
With wsProtestTest
.Cells(i + 2, 29) = equityRankRng: .Cells(i + 2, 30) = equityOutOfRng: .Cells(i + 2, 31) = Support3kLowerRng
.Cells(i + 2, 32) = MedianRng: .Cells(i + 2, 33) = propValRng
.Cells(i + 2, 34) = diffRng: .Cells(i + 2, 35) = MinRng
.Cells(i + 2, 36) = MaxRng: .Cells(i + 2, 37) = avgRng
End With
Next
Application.ScreenUpdating = True
End Sub
Редактировать: Фактически, что происходит: 1. Журнал используется для извлечения критериев для расширенного фильтра. 2. Столбец скорректированных значений очищается (промежуточные итоги), чтобы его можно было повторно заполнить позже после вычисления 3. Расширенный фильтр запускается с использованием критериев из более раннего 4. После запуска фильтра данные в возвращенных ячейках вытягиваются на лист (промежуточный итог используется для производить идентификацию для индекса/соответствия 1,2,3 и т. д. для каждой возвращаемой записи). Индекс/совпадение используется для заполнения различных элементов настройки, а затем используются базовые формулы для определения надлежащей настройки объекта (квадратные метры и т. д.). 5. Различные суммы суммируются на расчетном листе, чтобы получить «указанное значение». Затем это заполняет «valRng», используя соответствие индекса, которое вы видите в макросе. 6. Отфильтрованные данные сортируются в порядке возрастания на основе valRng. 7. Значения выносятся на итоговый лист для архивирования, так как остальная часть рабочей книги обновляется с каждой новой записью. (С разделом wsProtestTest).
