В попытке найти способы ускорить его, я переписал ваш код и прокомментировал его. Это то, что я придумал.
Private Sub TestOpen()
Dim WsSum As Worksheet ' give a meaningful name
Dim WsClient As Worksheet
Dim Tmp As Variant
Dim First As Long ' rows and columns are generally Long
Dim x As Long
Dim n As Long
Set WsSum = ThisWorkbook.Sheets("Payment_Summary")
Set WsClient = ThisWorkbook.Sheets("Client_Details")
Application.ScreenUpdating = False
' For the next line no worksheet is specified.
' Therefore the ActiveSheet will be referenced.
' Better specify the sheet.
Tmp = Range("Next_Payment").Value2 ' this must be a single cell
' Once you (correctly!) assign a sheet to a variable
' use the variable to refer to it in the code that follows.
With WsSum
On Error Resume Next
If Err Then
MsgBox "The match criterium """ & Tmp & """ wasn't found.", _
vbCritical, "Data error"
Else
First = Application.Match(Tmp, .Columns("A"), 0)
x = .Range("Duration").Value2 + 7
.Range(Rows(7), Rows(x)).EntireRow.Hidden = True
Select Case WsClient.Range("Freq").Value
Case "Weekly"
For n = 0 To Int(x / 7)
.Rows(First + (n * 7)).EntireRow.Hidden = False
Next
Case "Fortnightly"
For n = 0 To Int(x / 14)
.Rows(First + (n * 14)).EntireRow.Hidden = False
Next
Case "Monthly"
For n = 0 To Int(x / 30)
Tmp = WsClient.Range("Next_payment").Value
' which value should this be if Tmp is not a date
' from which the Day can be extracted? (I assign 1)
Tmp = IIf(IsDate(Tmp), Day(Tmp), 1)
If Day(.Cells(n + First, 1).Value) = Tmp Then
.Cells(n + First, 1).EntireRow.Hidden = False
End If
Next
End If
End If
End With
Application.ScreenUpdating = True
End Sub
Не задерживайте дыхание, моя версия не будет работать быстрее, чем ваша. На самом деле, это может не работать вообще. В этом случае, пожалуйста, потерпите меня и исправьте ошибки, которые вам покажет отладчик. Я не смог выполнить тест, и могут быть некоторые опечатки.
Цель этого упражнения состояла в том, чтобы понять код. Это то, что я понял. Вы смотрите на диапазон Freq и принимаете меры в зависимости от его значения, которое описывает период типа «еженедельно», «ежемесячно», «раз в две недели». Поскольку ячейка может содержать только одно значение за раз, оператор Select Case более подходит чем повторяется Ifs.
В каждом случае вы ищите значение «x», которое, как я понимаю, находится в области 8000. У меня есть некоторые сомнения относительно точности вашего определения строк, которые вы sh скрыть, потому что x + 7 выглядит так, как будто он предназначен для еженедельных списков. Когда вы делите на 30, результат может оказаться не тем, что вы хотите. Я бы использовал Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row, чтобы определить последнюю строку (= x), а затем l oop с For n = First To x Step 7 (или 14 или 30) для определения каждого 7-го, 14-го или 30-го ряда. Но это также не будет быстрее, чем у вас.
Спросил, как бы я сделал это быстрее Я должен сказать, что я бы вообще не использовал этот вид кода. Я бы искал способ применения фильтра. Если лучшего способа не найти, создайте вспомогательный столбец и напишите код для ввода * 1015. * в строках, которые вы хотите показать. Фильтр n для «x».
Чтобы быстро назначить «x» для 8000 строк, используйте этот вид конструкции.
Dim Arr As Variant
Dim Rng As Range
Dim i As Long
Redim Arr(1 to 8000) ' use x
For i = 1 to Ubound(Arr) Step 7
Arr(i) = "x"
Next i
Set Rng = Ws.Cells(First, Helper).Resize(Ubound(Arr),1)
Rng = Application.Transpose(Arr)
Вы можете использовать большую часть существующего кода для написания этой процедуры и я гарантирую, что это будет быстрее. Вы можете даже добавить код для применения фильтра.