Подскажите, пожалуйста, возможно ли ускорить процесс удаления строк в умной таблице с помощью VBA по сравнению с тем, что у меня в файле-примере? Мой текущий код работает в принципе, однако если таблица большая и данных много, то процесс сильно затягивается.
Код:
Код
Sub DeletingRows()
Dim arrData, tblData As ListObject
Set tblData = Sheets(1).ListObjects(1)
arrData = tblData.Range.Value
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
For i = UBound(arrData) To 1 Step -1
If arrData(i, 1) = Sheets(1).Range("F3").Value Then
tblData.Range.Rows(i).Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton1_Click()
Dim arrData()
Dim Compare ' что там? тип переменной?
Dim rRng As Range
arrData = Sheets(1).ListObjects(1).Range.Value
Compare = Sheets(1).Range("F3").Value
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For i = 1 To UBound(arrData)
If arrData(i, 1) = Compare Then
If rRng Is Nothing Then
Set rRng = Cells(i, 1)
Else
Set rRng = Union(rRng, Cells(i, 1))
End If
End If
Next i
If Not rRng Is Nothing Then rRng.EntireRow.Delete
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
А сортировать по первому столбцу можно? Кстати, никто не подскажет как избавиться от On Error Resume Next - не нашёл как проверить, что после фильтрации у меня хоть какие-то видимые строки остались.
Код
Private Sub CommandButton1_Click()
Dim arrData, tblData As ListObject
Set tblData = Sheets(1).ListObjects(1)
arrData = tblData.Range.Value
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
' For i = UBound(arrData) To 1 Step -1
' If arrData(i, 1) = Sheets(1).Range("F3").Value Then
' tblData.Range.Rows(i).Delete
' End If
' Next i
tblData.Sort.SortFields.Clear
tblData.Sort.SortFields.Add tblData.ListColumns(1).Range
tblData.Sort.Apply
tblData.Range.AutoFilter Field:=1, Criteria1:=Sheets(1).Range("F3").Value
On Error Resume Next
tblData.DataBodyRange.SpecialCells(xlVisible).EntireRow.Delete
On Error GoTo 0
tblData.AutoFilter.ShowAllData
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
RAN, на самом деле, там немного сложнее: в оригинальной версии у меня есть массив, в котором различные значения, а макрос сранивает эти значения по каждой строке в таблице - если критерий есть, то удаляет, если нет, то оставляет. Короче говоря, от обращений к листу максимально избавился, все вычисления в массивах.
vikttur, Inexsu, спасибо, сейчас попробую.
RAN, а что значит: сошел с дистанции?
Wiss, сортировать нельзя, к сожалению, подразумевается, что критерии могут встречаться в произвольном порядке.